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FOREWORD 


This report documents the GDC version of the SIMWEST computer programs devel- 
oped by Boeing Computer Services Company under NASA Contract DEN3-42» “An 
Expanded System Simulation Model for Solar Energy Storage". The SIMWEST codes 
were originally developed for simulation of wind energy storage systems. The 
current version of these codes also includes solar-photovoltaic energy systems 
modeling. This project was conducted under the sponsorship of the Division of 
Energy Storage Systems, DOE, under the direction of Dr. G. C, Chang, and was 
administered by the NASA-Lewis Research Center Thermal and Mechanical Storage 
Section with Mr. L. H. Gordon and Mr. R. H. Beach as Project Managers. 

This report is in two volumes. 

I. CDC User's Manual 
II. CDC Program Descriptions 

The Boeing principal investigator for this project was Dr. A. W. Warren. Major 
contributors in the development of SIMWEST were Dr. R. W. Edsinger, Dr. J. D. 
Burroughs, and Dr. Y. K. Chan. 
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1.0 INTRODUCTIOK 


This volume describes the computer programs for the CDC version of SIMWEST 
released 1n March 1979, Each of 'e following sections contain a verbal 
program description with macro flow charts, and source code listings for each 
major program entity. Section 2.0 describes the model generation precompiler 
program (EASY) which creates a Fortran model for the system to be simulated. 
Section 3.0 describes the simulation program (NONSIM). This is the executive 
program that exercises the Fortran model generated by the model generation 
program. Section 4.0 describes the file maintenance program (FILOAD). Section 
5.0 describes the printer plotter program (NSMPPT) which is a post processor 
for the simulation program. The component library source listings are given in 
Section 7.0 of Volume I, CDC User's Manual. 
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2.0 MODEL SENERATIOfi PROGRAM DESCRIPTION 

2.1 INTRODUCTION 

The Model Generation program accepts program comnands which describe the sys- 
tem model In terms of standard components. Each standard component Is repre- 
sented by a subroutine. The program. then constructs a FORTRAN model which 
consists of a series of calls to these subroutines. In addition to generating 
the FORTR/yi source code for the system model, the Model Generation program 
produces a line printer drawn schematic diagram of the system and a list of the 
input data required to complete the model description. 

Upon completion of model generation, the FORTRAN source code is compiled and 
the resultant object code is available as input to the simulation program. The 
model source code may be punched onto cards for storage or manipulation by the 
system analyst. The model object code is also stored on a permanent file. In 
this way a given model can be used for several simulation runs without having 
to regenerate the model for each analysis. 

2.2 PROGRAM STRUCTURE 

Figure 2.2-1 contains a macro flow diagram of the Model Generation program. 
This flow diagram shows the principle tasks of the program. For each task, a 
statement number in the main program is given along with the name of the 
principle subroutine that accomplishes the task. 

The first task upon starting program execution is to obtain the current list of 
all standard components. The SIMWEST program was designed to be independent of 
the number or type of standard components. All that is required of the 
standard components is that their inputs, outputs, and table quantities be 
arranged according to certain rules discussed in Section 6.0, Volume I. 

The sequence of performing the subsequent tasks is very model dependent. As 
each task is identified and performed, data describing the system model are 
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FIGURE 2.2-1 SIMWEST MODEL GENERATION PROGRAM - MACRO FLOW DIAGRAM 
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accumulated on a random access temporary file. This file, TAPE7, contains a 
11st of inputs for each component ih the system model. As inputs are satisfied 
by model connectionsj their names are modified to indicate the source of the 
input information. A list of model component names, CMPHOD, is kept in core. 

In addition to the component name, this list contains codes indicating the 
location of the component on the model schematic, the symbol to be used for the 
component and the number of inputs the component requires. 

Once the END OF MODEL command is received, the data accumulated for the model 
is processed to generate the model source code and the model schematic diagram. 

The following sections describe each of the major tasks shown in Figure 2.2-1. 
Source listings for all subroutines are included in Section 2.3. 

2.2.1 Command Interpretation 

The second task performed by the program is to begin the interpretation of data 
cards which contain the system model description commands. Figure 2.2-2 con- 
tains a macro flow diagram of the command interpretation process. 

As each command card is read, it is printed to provide a record of progress 
through the model description. The model description is given as a series of 
"phrases”. These phrases are identified in each card image by the routine, 
NXTPH, which locates one of the allowable phrase delimiters: comma, [,], 
equals, [=], left or right parenthesis, [()], or three or more blanks. When 
the end of a card is reached, a blank phrase is returned by NXTPH which causes a 
new command card to be read. 

Each phrase is first tested against the set of command phrases, shown in Table 
2.2-1. If a match Is obtained between the first ten characters of the input 
phrase and one of the conmand phrases, the program branches to statement 400. 

At statement 400, tests are performed for unfinished tasks such as component 
definition that mu*’’ be completed, or the end of the direct FORTRAN input task. 
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FIGURE 2.2-2 MODEL GENERATION COMMAND INTERPRETATION - MACRO FLOW DIAGRAM 
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TABLE £.2-1 MODEL GENERATION PROGRAM COMMAND PHRASES 


PHRASE 

ADD PARAMETERS 
ADD STATES 
ADD TABLES 
ADD VARIABLES 
DIAGNOSTIC CONTROL 
END OF MODEL 
FORTRAN STATEMENTS 
INPUTS 

LIST STANDARD COMPONENTS 
LOCATION 

MODEL DESCRIPTION 

PRINT 

PUNCH 


USE 

Direct addition of parameters to model 
Direct addition of states to model 
Direct addition of tables to model 
Direct addition of variables to model 
Control diagnostic printout to model 
Specify end of model description 
Specify start of FORTRAN statements 
Specify input components 
Request listing of standard components 
Specify component location on schematic 
Specify start of model description 
Requested printed model output 
Request printed and punched model output 
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Once any unfinished task has been completed, a branch is made at statement 420 
to the new task. 

If the input phrase is not identified as a conmand phrase, its first two 
characters are compared to the list of standard component names, at statement 
325. If the phrase is identified as a standard component, the program proceeds 
to either the new component routine, NEWCOM, or the component Input routine, 
INCOM, depending on the current task. 

If a particular command phrase requires additional modifying phrases, these 
phrases will be located on the command card and examined as to their suita- 
bility as a part of performing the requested task. For example, the INPUTS 
task will check for modifying port numbers or physical quantity names associa- 
ted with the input component. The "suitability" of a phrase will be determined 
by assuring that it is numeric, a physical quantity name, etc. depending on the 
specified task. 

2.2.2 LOCATION Command Execution 

The LOCATION command introduces the definition of a new component into the 
system model. This command must be followed by a numeric phrase that specifies 
the component location on the model schematic diagram. Failure to furnish a 
numeric location number causes a warning to be printed and the component will 
not appear on the model schematic. 

If the previous conmand involved the specification of a component LOCATION, or 
INPUTS, the input quantity list for that component is stored before examining 
the next phrase as a valid location number. 

2.2.3 New Component Name Examination 

The next phrase following the location number phrase should contain the name of 
a standard component. When this occurs, the subroutine NEWCOM is called. 
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If the name is not that of a standard component* a warning message will be 
printed and the program will continue on with command card interpretation. 

A flow diagram of the NEWCOM subroutine is shown in Figure 2.2-3, The main 
purpose of the NEWCOM subroutine is to get copies of the input and output lists 
for the specified component. Master copies of these lists are stored on input 
file TAPE78 for all standard components. However, if a component has already 
appeared in the model description, an input list for that component will be 
stored on local file TAPE7. This copy of the input list must be used since it 
may contain information regarding previous connections. 

Additional tasks performed by NEWCOM include storing the symbol number, loca- 
tion number, and number of inputs, in the component name. These three integer 
numbers are stored in the last six characters of the component's name by means 
of the PUTCOD routine. The PUTCOD routine allows up to 5 integer values to be 
stored in a single 10 character word. These integers may assume values between 
± 2047. The routine GETCOD is used to retrieve these values. Figure 2.2-4 
shows how the ten characters of each model component's name are used. 

The PUTCOD routine is also used to store each model component’s identification 
number, IDCOMP* in the LOCATION sequence array, SEQA, Components are assigned 
consecutive identification numbers as they first appear in a model descrip- 
tion. These numbers define the sequence of component names in the model 
component name list, CMPMOD, and are used as the record numbers for Lhe com- 
ponent input lists on the mass storage file TAPE7. The sequence array, SEQA, 
stores the component identification numbers in the sequence that is specified 
by the components' LOCATION statements. In some cases this sequence may differ 
from that of first appearance in the model description. The LOCATION statement 
sequence specifies the sequence that each model component subroutine is to be 
called in the system model. 
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FIGURE 2.2-4 USE OF CHARACTERS IN COMPONENT NAMES 
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2.2.4 Inputs 

The INPUTS command proceeds one or more instructions specifying those com- 
ponents which provide inputs to the component which has just been located. 
Component interconnections are made in the routine INCOM. Connections are 
recorded in the lists of inputs which are generated for each component as they 
are introduced into the model. The source of an input is indicated by replac- 
ing the standard physical quantity input name with the output quantity name of 
the source. Characters 4 through 7 of this name identifies the source com- 
ponent. 

Figure 2.2-5 gives a macro-flow diagram of the INCOM routine. Upon entering 
the INCOM routine, input and output name lists are obtained for the upstream, 
i.e., input component. If this is the first appearance of this component, the 
input list is obtained from the input file TAPE78, via the routine COMDAT. If 
the component had previously appeared in the model, it will have an input list 
on local file TAPE7, which will be used. The next phrase after the upstream 
component name is then examined. There are three valid possibilities for this 
phrase. It can be blank or another standard component name in which case the 
default option of connecting all matching physical quantities at a pair of 
ports is taken. If this phrase is numeric, it is assumed that ports are being 
specified and all matching quantities at those ports are connected, via the 
routine PORTCN. If the phrase Is alphanumeric and matches an output quantity 
of the upstream component, only the specified physical quantities are connec- 
ted. Before returning from the INCOM routine, the input list for the upstream 
component is stored on TAPE7. 

2.2.5 END OF MODEL Command Execution 


The END OF MODEL command indicates the end of the model description. This 
command initiates the model generation process by the ENDHOD subroutine. The 
ENDMOD subroutine generates the FORTRAN source code for the system model rou- 
tines EQMO, DATAIN, and BLOCK DATA MODEL and forms the model input requirements 
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list. The principle sources of data for the ENDMOD routine are: (!) the 
collection of input name lists for each model component, stored on TAPE? ; 
(2) the list of model component names, CMPMOD; and (3) the location sequence of 
the model components, stored in SEQA. These lists describe all connections 
that have been made between standard components, the component names, and their 
location sequence in the model description. Figure 2.2-6 gives a macro flow 
diagram of the ENDMOD subroutine. 

The subroutine COMORO is called to assure that the model equations are in 
explicit form. This is done by forming a binary connection matrix for the 
system model. Only those inter-component connections that involve variables 
are considered. For the model to be explicit, no component can receive an 
input from a variable which is calculated by a component occuring after it in 
the calculation sequence. Since states are not calculated by the component 
subroutines, (only their rates are), their values do not change within the EQMO 
routine and they can be used as Inputs to any component in the model. If any 
direct FORTRAN STATEMENTS appear in the model, they are assumed to be dependent 
on all preceding components in the sequence. The COMORO routine calls the 
subroutine ORDER to test if the connection matrix is in lower triangular form, 
indicating an explicit system model. If this is not the case, ORDER will 
attempt to put the connection matrix in lower triangular form by rearranging 
the sequence of component subroutine calls. If a successful rearrangement can 
be made, a notice of those components whose sequence was changed will be 
printed. If the system model contains an implicit loop which cannot be removed 
by rearranging the component sequence, a warning will be printed, pointing out 
those components that form the implicit loop. 

Once the sequence of model component calls has been established by COMORD, the 
source code for the subroutine calls is generated by the routines CALLCP and 
ENOCOM for standard components. This source code is temporarily stored on 
TAPE12. Lists of the state, variable, and parameter names contained in the 
model are also generated at this time and added to TAPES, TAPEll, and TAPEIO, 
respectively. These tasks for all system model components and any direct 
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FIGURE 2.2-6 SUBROUTINE ENDMOD - MACRO FLOW DIAGRAM 
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FORTRAff STATEMENTS, are completed when statement number 90 of ENDMOD is 
reached. 

The source code statements for EQMO are next written onto TAPE9. The subrou- 
tines COMGEN and TABGEN are used to generate common statements for the model 
states, variables, parameters, and tables. The calls to standard components 
are transferred from TAPE12 to TAPE9 and the VARSET and RATSET entry point 
statements are added to TAPE9 to complete the source code for EQMO. 

At ENDMOD statement number 700, the generation of subroutine DATAIN begins. 
The statements in DATAIN provide default values for the integrator error con- 
trols and the value of .99999 for all model parameters. If tables are present 
in the models, the routine TABDAT generates the conmon /CTABLE/ containing the 
single array TABLES which is used to load tabular data into the model. TABDAT 
also loads the arrays, TABNAM, MAXDIM, and L0CTA8 with the table names, maximum 
dimensions, and pointers that are used In the table data input process. 

At ENDMOD statement number 860, TAPE12 is rewound and the start of the Input 
Requirement List for the model is placed on it. Subroutine TABCAL is called to 
place the table Information in this list. A call to the table input routine 
TABIN is added to TAPE9, completing the DATAIN subroutine source code genera- 
tion. 

The BLOCK DATA MODEL routine source code is then added to TAPE9. The routine 
COMEQU is called once for each of the state, variable, and parameter name 
lists. This routine generates additional name arrays and equivalence state- 
ments whenever the number of names in a list exceeds 130. This is necessary to 
accommodate a compiler limitation of only 19 continuation cards in a single 
data statement. The NAMARY routine is used to transfer the state, variable, 
and parameter names from Tapes 8, 11, and 10 into source code data statements 
on TAPE9. The final task of the ENDMOD subroutine is to add the parameter and 
state names of the model to the Input Requirement List on TAPE12. 
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2.2,6 FORTRAN STATEMENTS CoiTimand Execution 


The FORTRAN STATEMENTS comniand allows FORTRAN source statements to be inserted 
directly into the system model. When this command phrase is encountered, a 
component name of FORT is added to the model component name list. Subsequent 
lines of instructions are then placed on the source file, TAPE9. The first 
phrase of each subsequent line of instruction is compared with the SIMWEST 
command phrases. When a recognizable command is encountered, the direct FOR- 
TRAN mode terminates and the word FORT is written onto TAPE9 to mark the end of 
that block of FORTRAN statements. The recognized comiiand is then executed. 

Tests are included in the ENDMOD and COMORO routines to provide special hand- 
ling of any "FORT" components. If the ENOMOD routine encounters a FORT com- 
ponent while generating calls to standard components, it transfers the FORTRAN 
source statements from TAPE9 to TAPE12, thus placing them in the proper 
sequence in the model equation subroutine, EQMO. If the COMORO routine 
encounters a FORT component while generating the model connection matrix, it 
specifies that Inputs are provided to the "FORT" component by all previous 
components in the model sequence. This assumption assures that any inputs 
available to the FORTRAN statements in the given model sequence will also be 
available if the model component sequence is rearranged to remove implicit 
expressions. 

2.3 MODEL GENERATION SOURCE LISTINGS 

Compilation listings of the source code for the model generation program fol- 
lows. Several subroutines such as NXTPH and KOMSTR are used in several of the 
programs and will be found in the source listings for the FILOAD program 
(Section 4.3). The names of the model generation routines, listed in alpha- 
betical order, are as follows: 
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BLOCK DATA 

LINE 

CALLCP 

LISTSC 

COMEQU 

NAMARY 

COMGEN 

NAMGEN 

COMORO 

NEWCOM 

CONNCT 

ORDER 

EASY 

PORTCN 

ENDCOM 

SCHEMA 

ENDMOD 

SYMBOL 

HLINE 

TABCAL 

IJBIT 

TABDAT 

IJBITl 

TABGEN 

INCOM 

VLINE 


BCS 40262-2 


SLOCK DATA 

COMMQN/COC IMP/D Cl MPT i 1 0 ) /COCOUT/OCOUTP UO )/COCCR I/OCCRIT< 10) 
COMM DM/C OC/MOC IN ^ NOC OUT , NQC * NOCMOD , NOCCR » LOCQC 1 1 OC AN , I XGC 
DATA DCINPT/100#aH )/,OCOUTP/100’4=t IH )/ 

DATA NDCIN/0/,NDCOUT/0/,NOC/-I/TNOCMOD/-l/,NOCCR/0/fLOCDC/-l/ 
It I0CAN/0/,IX0C/l/ 
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CCALLCP 

SUBROUTINE CALLCPtCQMNAMrNOCOMP,SOURCE,ISOUR?IVRSETTOUTPUT ) 

VERSION 2. revised: DEC 15 1975 

purpose: to INITIATE CALL GENERATION FOR STD. ECS COMPONENTS 

CALL SEQUENCE: COMNAM - COMPONENT NAME 

NOCOMP - COMPONENT NUMBER 
SOURCE - SOURCE CODE ARRAY 
ISOUR - SOURCE CODE ARRAY POINTER 
IVRSET - ARRAY CONTAINING VARSETjRATSET INFORMATIO 
OUTPUT “ WORK ARRAY FOR OUTPUT TABLE NAMES 
COMMON/CIO/IREAD, IWRITEr IDIAG/CTA3/N0TAB,TABNAHt 1 > 

COMMON /CORDER/NDX,NOVrNOP 
DIMENSION IVRSETtDcSOURCEtS) 
ltCALLS{2)T0UTPUTin^XD0T{2) 

DATA NEWCMP/IOHNEW CDMPNT/,C0MMA/10H, / 

DATA BLNK/XOH / 

DATA CALLS/20H CALL ( / pXDOT/20HrXDOT ( ) , INT ( ) / 

C > SAVE NO. OF VARIABLES AND STATES BEFORE COMPONENT IS FORMED 

I =4=4= NOCOMP -3 

CALL PUTCODJ I, IVRSET, NQVJ 
X=4=4=NOCOMP“-l 

CALL PUTCODCl,IVRSET,NOX) 

WRITE(12j7X)C0MNAM 

71 FORMAT {*C*/=4=C*,20X SUBCOMPONENT A4/=f=C=4=i 

C > LOAD SOURCE WITH CALL XX ( 

DO 100 1 = 1, -8 
IF(I.LE-2i GD TO 80 
SOURCE ( I i = BLNK 
GO TO 100 

80 SOURCEJ I)=CALLS(I} 

100 CONTINUE 

C -- -> LOAD STANDARD COMPONENT SUBROUTINE NAME 

CALL STRM0VtC0MNAMsl»2j S0ULCE,12} 

IS0UR=15 

c . — > Ggj list of tables for component 

CALL CQHDAK COMNAM, 4HTABS ,NTAB, OUTPUTS 

C > TEST IF TABLES ARE REQUIRED BY SUBROUTINE 

IF(NTAB,LE.O) GO TO 300 

C > ADD TABLE ARGUMENTS TO CALL SEQUENCE 

IF(IDIAG.GT.6OSWRITEtIWRITE,101MOUTPUTJ I) ,I=1,NTAB) 

101 FQRMATt* CALLCP~TABLES#/tlX,6A10n 

C > SCAN REQUIRED TABLES 

DO 200 I=1,NTAB 

C > CONSTRUCT TABLE NAME 

ANAME=OUTPUT(IS 

CALL STRMOV (COMNAM, 1 ,4, ANAME ,4 ) 

Q add table name to TABLE LIST 

NOTAB=NOTAB+1 
TABNAMI NOTAB )=ANAME 

IF{I.GT-11 CALL LINE(0, SOURCE, ISDURjCQMMAsljiaS 
CALL LINE (OeSOURCE, ISOUR, ANAME, 7, 12) 

200 CONTINUE 

Q ,> QEf list of OUTPUT QUANTITIES FDR COMPONENT 

300 CALL COMDATl COMNAM, 4H0UTP,NQUT, OUTPUT) 

IFCIDIAG.GT.BO) WRITE { IWRITE ,303i { 0UTPUTms 1=1, NOUT) 

303 FORHATC* CALLCP‘-0UTPUTS=4=/aX,6A10) ) 
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C SCAN OUTPUT QUANTITIES 

DO 400 I^=l»NOUT 

C > CONSTRUCT OUTPUT QUANTITY SPECIFIC NAME 

CALL NAHGENtQUTPUTiI),COHNAM»ANAM£) 

C > get lOTK CHARACTER IN STD. NAME TO DETERMINE IF QUANTITY 

C IS A STATE OR A VARIABLE 

CALL GETTC OUTPUT (IN 10, TYPE) 

C > test for STATE OR VARIABLE 

IF(TYPE.NE.BLNK) GO TO 320 

C > INCREMENT VARIABLE COUNTER 

NQV=NOV+X 

WRITEU1,305)ANAME 
305 FQRHAT{A10) 

GO TO 330 

C > INCREMENT STATE COUNTER 

320 NOX-NOX+1 

WRITEC8,305)ANAME 

330 IF(NTAB.GT.O.OR.I.Gt.l) CALL LINE ( 0 ,SOURCE , ISOUR .COMMA, 1, 12 ) 

C > ADD OUTPUT NAME TO CALL SEQUENCE 

CALL LINE{0,S0URCE, ISOUR, ANAHE,7, 12 ) 

IF(TYPE.EQ.BLNK) GO TO 400 

C > CONVERT CURRENT NO. OF STATE TO BCD 

ENCDDE(3,3A0,N0)NDX 
340 FORM AT ( 13) 

C > LOAD CURRENT STATE NO. AS RATE SUBSCRIPT 

CALL STRM0VlNa,l,3,XDQT,7) 

C > LOAD CURENT STATE NO. AS INT SUBCRIPT 

CALL STRH0V(NQ,1,3,XDQT,16) 

CALL LINE ( 0, SOURCE, ISOUR, XDOT ,19,12) 

AOO CONTINUE 

IFdDIAG.GE. 50 )WRITECIWRITE, 405) SOURCE 
405 FORMAT(^ CALLCP-SOURCE=S^/( 1X,6A10 ) ) 

C — ~> SAVE NO. OF VARIABLES AND STATES AFTER COMPONENT IS FORMED 

i-4*N0CaHP-2 

CALL PUTCODtI,IVRSET,NOV> 

I=4^NQC0MP 

CALL PUTCODlI,IVRSET,NOX) 

XFUDIAG.EQ.55) WRITEl IWRIT£,401> I IVRSETt I ) , 1=1, NOCOMP ) 

401 F0RMAT(4: CALLCP-IVRSET’i=/3 { 2X, 020 ) ) 

RETURN 

END 
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CCQMEQU 

SUBROUTINE COH£QUfNAME,N) 

C VERSION 1.0 revised: AUG 28 1975 

C purpose: create EQUIVALENT NAME ARRAYS TO ALLOW DATA STATEMENTS 

C TO LOAD NAME LISTS EXCEEDING 130 NAMES. 

C CALL sequence: NAME - NAME OF ARRAY TO BE EXTENDED 

C N - NUMBER OF NAMES IN LIST 

C DESIGNED BY: J.D. BURROUGHS AUG 1975 

C > CALCULATE NO- OF EXTENSIONS REQUIRED 

NEXT=(N“1J/130 

IFtNEXT.LE.O)RETURN 

C > ADD AN EQUIVALENCE STATEMENT FOR EACH EXTENSION REQD. 

DO 100 I^lrNEXT 
J=130=^=I + l 

C CALCULATE NO. OF WORDS IN EXTENSION 

X-N-J+l 

lFtK.GT.130)K=130 
WRirEf9s8l}NAHE*I,K,NAHE» J»NAME,I 
81 FORMAT(6X,4'DIM£NSION A5, I2,^C*» I3 t* )*/ 

1 6X» ^EQUIVALENCE t >4:, A5, >5= t*» 15,=*') ,=K,A5»I2t ) 

100 CONTINUE 
RETURN 
END 
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CCOMGEN 

SUBROUTINE CD^GEN(Nj,CNAMEjNUNITsIUNITJ 
C VERSION 3- revised: JULY 12 1977 

C PURPOSES GENERATE COMMON STATEMENT GIVEN NAMES OF VARIABLES 
C STORED IN THE COMMON 

C CALL SEQUENCE: N » NO- OF VARIABLES IN COMMON 

C CNAME - COMMON NAME. (2 CHARACTERS) 

C NUNIT - FILE NO. CONTAINING NAMES 

C lUNIT - FILE NO. TO WHICH SOURCE CODE IS TO 

C BE WRITTEN. 

DIMENSION SQURCE(8),RNAMESC300> 

DATA INTEG/6HIJKLMN/ 

REWIND NUNIT 

C CALC. NO. OF EXTENSIONS TO COMMON STATEMENT REQ D 

INT^O 

NEXT=£N~l)/i56+l 
DO 400 J-1,N£XT 

Q COMMON EXTENSION COUNTER 

K=J-1 

C — NUMBER OF NAMES PER EXTENSION 
NAMES-N“K*156 

C LIMIT NO. OF NAMES PER COMMON TO 156 

NAMES-MINO (NAMES, 156) 

C GENERATE COMMON STATEMENT 

C > FORM COMMON NAME 

SOURCE [ IJ-IQH COMM 

S0URCE(2)=10HON / / 

CALL STRMOVCCNAME, 1,2, SOURCE, 15) 

DO 100 1-3,8 
100 SOURC6( I1=10H 
ISOUR=18 

C > SCAN NAMES 

DO 200 1=1, NAMES 
READ (NU N IT , 1 05 J ANAME 
105 F0RMAT{8A10J 
C TEST FOR INTEGER NAMES 

IF(ISCAN(ANAME,1,1,INTEG,1,6,KI-EQ.O)GO TO 110 

INT=INT-s-l 

RNAMES( INT)=ANAHE 


110 IFlZ.GT.l) CALL LINE40, SOURCE, ISOUR, IH,, 1 , lUNITJ 
CALL LINEtOjSOURCEsISOURsANAMEjTjIUNIT) 

C — — — test FOR DIMENSIONED QUANTITIES 

200 CONTINUE 

WRITE(iUNIT,l05)S0URCE 
400 CONTINUE 

C test IF INTEGER NAMES OCCUREO 

IFtINT.EQ.OJRETURN 
S0URCEIU = 10H REAL 

DO 500 1=2,8 
500 SOURCE! I )=IOH 

C SCAN INTEGER NAMES 

IS0UR=12 
DO 600 1=1, INT 

iFCI.GT.DCALL LINE 40, SOURCE, ISOUR, IH, ,1* lUNIT) 
CALL LINETO, SOURCE, ISOUR, RNAMES(I), 7, lUNIT) 

600 CONTINUE 

WRITE (lUNIT, 105 JSOURCE 

RETURN 

END 
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C COMORO 

SUBROUTINE COMORO tCMPHOD, NOCOMP , INPUTS ^ 

C VERSION 3. REVISED; JAN 6 1977 

C PURPOSE; ORDER COMPONENTS SO THAT MODEL EQUATIONS ARE EXPLICIT 
C CALL SEQUENCE: CHPMOD - ARRAY CONTAINING NAMES OF MODEL COMPONENTS 

C NOCQMP ” NUMBER OF COMPONENTS IN MODEL 

G INPUT - INPUT NAME ARRAY WORK SPACE 

C DESIGNED BY; J«D. BURROUGHS JULY 1975 


C0MMGN/CSEQ/NSEQ,SEQA{1)/CIQ/IREAD,IWRITE5IDIAG 
DIMENSION CMPMQD(l>,lNPUTSa) »CDNARR{667) ,ISEQ{200)?IWU200J 
1 rIW2(200) ,W1{200) ,W2{200) 

EQU I VAL ENCE { W1 t IW l ) , t W2 » XW2 ) 

C > TEST IP all COMPONENTS HAVE SEQUENCE NUMBERS 

IF{NSEQ.GE.NOGOMP)GO TO IQO 

C xs:=^===:==== ASSIGN SEQUENCE NOS. TO UNSEQUENCED COMPONENTS 
C — -> SCAN ALL MODEL COMPONENTS 

DO 85 I=1*NDCDMP 

C > SKIP FORTRAN COMPONENTS 

IFCCMPMODEI) .EQ»4HFQRT)G0 TO 85 

C > GET LOCATION CODE 

CALL GETC0Dt3,CMPM0DtI) fLOC) 

IFtLOC.GT-0}GO TO 85 

C > INCREMENT SEQUENCE NO. COUNT 

NSEQ=NSBQ+1 

CALL PUTCOD(NS£Q,SEQAf n 
85 CONTINUE 

C ZERO CONNECTION ARRAY 

1 00 NWORDS^M INOtNDCDMP^i'NQCDMP/SO-i-l t60 ) 

DO 120 I“1,NWDRDS 
120 C0NARRtI)=0. 

==:===:====== s form CONNECTION ARRAY 

> SCAN MODEL COMPONENTS IN CURRENT SEQUENCE 

COMP=10H 
DO 400 I=1tNSEQ 

Q > GPT COMPONENT NUMBER 

CALL GETCODC I,SEQApICOMP) 

C •> TEST FOR FORTRAN COMPONENTS 

IF{CMPMDDIICDMP).EQ»4HF0RTJGQ TO 360 

C > GET NUMBER OF INPUTS TO ITH COMPONENT 

CALL GETC0DC5,CMPM0D(IC0MP),N INPUT) 

C > SKIP COMPONENTS WITH ZERO INPUTS 

IFtNXNPUT.LE.O)GD TO 400 

C ==========^^ get INPUT LIST FOR ITH COMPONENT 

CALL READMS(7, INPUTS, NINPUTfICOMP) 

COMPS=10H 

C > SCAN INPUTS 

DO 300 K=1tNINPUT 

C > test TO IGNORE STATE INPUTS 

IF(KOMSTR( INPUTS tK), 10, 1,1HS,1)-EQ*0)G0 TO 300 

C > get name of COMPONENT PROVIDING INPUT 

CALL STRM0VCINPUTS{K),4,4,C0MP,1) 

C TEST TO SKIP PARAMETERS 

IF{CDMP.EQ,10H JGO TO 300 

C ■> TEST TO SKIP SEARCH FOR SEQUENTIAL INPUTS FROM SAME COMPQNEN 

IF(COMP.EQ-COMPS)GD TO 300 
CQMPS=COMP 
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c ========“-= SCAN COMPONENTS TO LOCATE SEQUENCE NO. OF INPUT 

DO 200 J=il,NSEQ 

CALL GETCODtJTSEQAsJCQMP) 

Q > COMPARE EACH COMPONENT WITH INPUT, COMPONENT 

IFtK0MSTR(CQMP,l*49CMPM0D(JC0HPI» D.EQ.OJGO TO 280 


200' CONTINUE 

WRITEaWRITE,20UCOMP,CMPMODCICOMP) 

201 F0RHAT(/5X,15H’f=^* WARNING *C AN T IDENTIFY *TAA,>f= AS A 

IVALID INPUT COMPONENT TO ^,A4/) 

GO TO 300 

C > SET I J BIT = 1 

280 CALL IJBITltC0NARR,i,J5NSEQ) 

300 CONTINUE 
GO TO 400 

C for FORTRAN COMPONENTS - REQUIRE ALL PREVIOUS COMPONENTS 

360 DO 380 J=1»I 

CALL IJBITK CONARR»I,0,NSEQ} 

380 CONTINUE 
400 CONTINUE 

c =====rs=;=:.=== LOAD SEQUENCE VECTOR 
DO 420 I=1,NSEQ 
420 I$EQtn = l 

C xx=--======= ORDER COMPONENTS 

CALL 0RDER(NSEQ>ISEQ*CQNARR»IWl»iW2,IERR0R?IB,IE) 

IFtIERR0R.NE-0)G0 TO 600 

C > TEST FOR SUCCESSFUL ORDERING 

NWDRDS=NSEQ/5+l 

c ======== SAVE COPY OF SEQUENCE ARRAY 

DO 500 I=1,NW0RDS 
W1(I)=^SE0A{I) 

500 CONTINUE 

C ^ — > set REARRANGEMENT COUNTER 

IREARR=0 

C > SCAN CONPQNENTS 

DO 540 I-i,NSEQ 

C > test if SEQUENCE HAS BEEN MODIFIED 

1F{ ISEQU) .EQellGO TO 540 
C > INCREMENT REARRANGEMENT COUNTER 

IREARR=IREARR+1 

C > GET COMPONENT NUMBER 

CALL GETCODtlSEQtDsWlpJCOMPJ 

C > SAVE COMPONENT NAMES OF THOSE COMPONENTS WHOSE SEQUENCE HAS 

W2(IREARR)=CMPM0D(JC0MP) 

CALL PUTCODtI»$EQA»JCOMP) 

540 CONTINUE 

C ~> TEST IF REARRANGEMENT OCCURED 

IF(IREARR.LE.O) RETURN 
WRITEa WRITE, 551 nW2a}»I-ltIREARR) 

551 F0RMAT(/5X,14H*^=^ NOTICE *=«^*,5X,*THE SEQUENCE OF THE FOLLOWING COM 

IPONENTS HAS BEEN ALTERED TO FORM AN EXPLICIT MODEL*//20{2X,A4}//> 
RETURN 


BCS 40262-2 


25 


c SCAN CDMPOf^ENTS THAT CAUSED IMPLICIT LOOP 

600 J=0 

DO 620 1=18, IE 

CALL GETCDDtIW2CI>jSEQA,JC0MPJ 
J=J + 1 

Q > SAVE NAMES OF COMPONENTS IN IMPLICIT LOOP 

WUJ }=CMPMOD(JCOMP> 

620 CONTINUE 

WRITE(IWRITE,62lHWltn ,1 = 1, J ) 

621 F0RMAT{/5X,15H**=«P WARNING 5X, #THE FOLLOWING COMPONENTS FORM AN 

1 IMPLICIT LOOP. V/20(2X,A4}//> 

RETURN 

END 


26 


BCS 40262-2 



ooooooooon or»o 


CCDNNCT 

SUBROUTINE CONNCTtPAGEj NPAGEtLOCt INPUTS*NOIN»CaMTAB»NOCOMP > 
VERSION 2* revised: DEC 15 1975 

purpose: form connecting line between two specified component 

SYMBOLS AND LABEL IPPUTS 

CALL SEQUENCE: PAGE - 13X56 ARRAY CONTAINING HOLLORITH 

REPRESENTATION OF A PAGE 
NPAGE - CURRENT PAGE NO. 

LOC - LOCATION OF SYMBOL TO WHICH LINE IS 
TO BE DRAWN 

INPUTS - ARRAY OF INPUT QUANTITY NAMES 
NOIN - NO. OF INPUT QUANTITY NAMES 
COMTAB - TABLE OF ALL COMPONENT NAMES AND 
THEIR LOCATIONS 
NDCQMP - NO. OF COMPONENTS 
COMMON/C IO/IREAD,IWRITEtIDI AG 
DIMENSION PAGEtl3,56) ,INPUTSa),COMTAB{l) 

C — > RECEIVING COMPONENT LOCATION LINE NO, 

L0CLIN=7*C (LOC-D/lOJ+4 

C “> RECEIVING COMPONENT LOCATION COL. NO, 

LQCCOL=t MODI LOC-1, 10 > + 1)4^13-6 

IFCIDIAG-EQ.30)WRJTEf IWRITE,13)( INPUTS fl>, 1=1, NO IN t 
13 FORMAT!* CONNCT-INPUTS*/ ( IX,6A10 ) > 

C > SCAN COMPONENTS LIST TO LOCATE INPUT COMP. 

DO 100 1=1, NOCOMP 

IFtK0MSTR(INPUTS,4,4,C0MTAB£Ii,U.EQ.0iG0 TO 120 

100 CONTINUE 

CALL STRMDVi INPUTS,4,4,INLIN,1) 

WRITE! IWRITE, 101 )INLIN, LOC 

101 FQRMAT!/5X,32H *** WARNING *** CAN T LOCATE ,A4, 

1 * AS AN INPUT COMPONENT TO LOCATION *»I4) 

C > RETURN IF INPUT COMPONENT ISN T IN COMTAB LIST 

GO TO 540 

Q get LOCATION OF INPUT COMPONENT 

120 CALL GETCODtS, COMTAB! IJ ,ILOC) 

C > DETERMINE PAGE OF INPUT COMPONENT 

IPAGE=! IL0C/100»*100 

C > COMPARE INPUT COMP. PAGE TO CURRENT PAGE 

IFIIPAGE.NE.NPAGETGO TO 420 

Q > CONVERT GENERAL PAGE LOC TO LOCAL PAGE LOC 

ILDC=IL0C“IPAGE 

Q > CALC. LOC. LINE AND COL. NO. FOR INPUT COMPONENT 

ILIN=7*( (ILDC-1J/10K4 ' 

ICOL=!MOD! ILOC-1 , 101+1 1*13-6 

Q test FOR INPUTS FROM DOWNSTREAM COMP. 

IDS=0 

lF(KaMSTR!INPUTS,8,l,lH , I > .NE.O ) IDS=1 

C > TEST IF RECEIVING COMP. AND INPUT COMP. ARE ON SAME LINE 

IF!ILIN“LOCLIN1200,130,220 

G > same LINE. TEST IF LEFT OR RIGHT 

130 IF! ICDL.GE.LOCCOUGO TO 140 

C > SAME LINE AND INPUT IS TO LEFT 

135 INC0L=ICQL+6 

IRC0L=L0CCDL-5 
ITC=IRC0L-7 
ITL=2-L0CLIN 
GO TO 160 
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c — > same line and input is to right 

lAO INCOL=I COL-5 

IRGQL=LQCCOL+6 . 

ITC=IRCOL+l 

ITL=LDCLIN+2 

C > ADD HORIZONTAL LINE 

160 IFt IDS-NE-OJGD TO 500 

CALL HLINEtPAGE,ILlN,INCOL,IRCOL) 

GO TO 500 

C — -> INPUT IS ABOVE. TEST IF LEFT OR RIGHT 

200 IF(IC0L-L0CC0L)300,240,320 

C > ABOVE AND SAME COLUMN 

240 JNLIN-ILIN+3 

IRLIN=L0GLIN-4 
ITC=L0CCQL+3 
ITL=1-IRLIN 
GO TO 280 

C — > INPUT IS BELOW. TEST IF LEFT OR RIGHT 

220 IFaCOL“LOCCOL)34O,260,360 

C > BELOW AND SAME COLUMN 

260 INLIN=I LIN-4 

IRLIN=LDCLIN+3 

ITC=L0CC0L-8 

ITL=IRLIN+1 

C > ADD VERTICAL LINE 

280 IFtIDS.NE.O)GO TO 500 

CALL VLINEtPAGEsICQLjINLINjIRLIN) 

GO TO 500 

C > INPUT IS IN UPPER LEFT QUAD. 

300 IFtIDS^NE.O)GO TO 135 
L1N=ILIN+1 
INC0L=IG0L+6 
IRCOL-LOCCOL-1 
ICQ=IRCOL 
INLIN=LIN 
IRLIN=L0CLIN-4 
ITC= LOG COL-9 
1TL=.1-IRLIN 
GO TO 400 

C — > INPUT IS IN UPPER RIGHT QUAD. 

320 IF( IDS.NE.OIGO TO 240 
LIN=L0CLIN-1 
INCOL-ICOL-I 
IRCDL=L0CC0L+6 
ICO-INCOL 
INLIN=ILIN+3 
IRLIN=LIN 
ITC=L0CC0L+7 
ITL=1-IRLIN 
GO TO 400 

C > INPUT IS IN LOWER LEFT QUAD. 

340 IF{IDS.NE.O)GO TD 260 
LIN=LaCLrN+l 
INCOL=ICOL+l 
IRCQL=LOCeOL-5 
ICO=INCOL 
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INLIN=I LIN-4 
IRLIN-LIN 
ITC=IRCaL“6 
ITL=IRLIN+1 
GO TO 400 

C > INPUT IS IN LOWER RIGHT QUAD. 

360 IFdDSoNE.OlGO TO 140 
LIN-ILIN-l 
INCOL=I COL-5 
IRCOL-LOCCOL+l 
ICO=XRCOL 
INLIN^LIN 
IP,LlN=L0CLlN+3 
IVC-IRCOL’i-2 
ITL=IRLIN+1 

C — > ADD VERTICAL LINE SEGMENT 

400 CALL VLINE (PAGE* ICQ, INLINsIRLINJ 

C -> ADD HORIZONTAL LINE SEGMENT 

CALL HLINE{PAGE,LIN*INCOL,IRCOU 
GO TO 500 

C — > INPUT IS FROM ANOTHER PAGE 

Q ___ TEST TO PREVENT OFF PAGE SYMBOL FROM FALLING OFF PAGE 

420 IF(LQCLIN+7-GT. 56. OR, L0CC0L-16.lt .UGO TO 440 

C — > GENERATE EXTERNAL PAGE SYMBOL 

CALL PUTT t PAGE tl»L0CLIN-s-3),LDCCQL-5»lH/> 

CALL PUTTtPAGE{l9L0CLlN+4) ,L0CC0L-7, IH/) 

CALL STRM0Vt7H*>K4;^*=i=/9l979PAGE{l»LQCLIN+5J,L0CC0L-15) 

C > PLACE EXTERNAL PAGE NO. IN EXTERN i^L PAGE SYMBOL 

IPAGE=IP AGE/100 
ENC0DE{8r42l9lPAGE>IPAGE 

421 FORMATt SH^i'PAGEjIZdH*) 

CALL STRMOV( IPAGE jl,8,PAGE ( Ij LDCLIN+6) ,L0CC0L-16 ) 

CALL STRM0Vl6H*«^H:*!j:,l5 6tPAGBli9L0CLIN+7)7L0CC0L-15) 

440 ITC=^LOCCOL-16 
ITL=LOCLIN>5-8 

C > ADD TEXT TO INPUT LINE 

500 K=ISIGNrisITL) 

ITL^IABSMTLi 
IFtNQIN.LT.DGO TO 540 

C PREVENT LABELS FROM FALLING OFF SIDES OF PAGE 

IFf ITC-LT.1IITC=1 
lFtITC.GT.123)ITC=123 

Q TEST FDR LABELS GOING OFF TOP OR BOTTOM OF PAGE 

IDS^ITL+K’i' {NOlN-n 

C REVERSE DIRECTION OF COLUMN TO PREVENT LOSS OF LABELS 

IFC IDS.LT.1.0R.IDS.GT.56)K=-K 
C - — > SCAN INPUTS FROM INPUT COMP. 

DO 520 I=l,NaiN 

C - — TEST TO ASSURE THAT LABELS STAY ON PAGE 

IF(ITL.LT.1.0RaITL.GT.56)GO TO 540 

G > add input NAMES TO PAGE 

CALL STRM0V{ INPUTS t I) ,1,7 , page ( 1, ITU fITC) 

C — -> INCREMENT PRINT LINE EITHER UP OR DOWN 

itl=itl+k 

520 CONTINUE 
540 NOIN-0 
RETURN 
END 
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CEASY 

PROGRAM eASYtINPUT=100,OUTPUT=100»TAPE5=INPUTrTAPE6=QUTPUT 

1 ?TAPE7=100TTAPE8=100»TAPE9~IOOtTAPE10-100,TAPEll“100rTAPE12=100t 

2 TAPEA=100,TAPE7a=100,PUNCH=100,TAPE3:=PUNCH) 

C VERSION 4. REVISED JUNE 27 1977 

C purpose: to GENERATE FORTRAN SOURCE OF ECS MODEL IN THE 

C FORM REQUIRED SY THE NONSIM PROGRAM. 

C LIMITATIONS: ARRAY DIMENSIONS IMPOSE THE FOLLOWING LIMITS 


C 

r 

LIMITED QUANTITY 

CURRENT VALUE 

ARRAYS 

IMPOSING THE LI 

o 

c 

STANDARD COMPONENTS 

K 


150 

Msni} 

K“fI~3}/6 

c 

r 


R 

- 

150 

CHPNTSU) 

K=I~1 

-L» 

C 

STD. COMPONENTS PER MODEL 

K 


200 

IVRSETCI) 

R=I*5/4 (ENDMOD) 

C 


K 

=: 

200 

CONARRCI ) 

K={60*I)**-5 CCOMORD 

c 


K 

= 

200 

rSEQ{I} 

K“I (COMORO} 

c 


K 

= ■ 

200 

IWltl) 

R=I ( COMORO) 

c 


K 

= 

200 

IW2(I) 

K=I { COMORO) 

c 


K 


200 

CMPMOD( n 

R=I 

c 


K 


200 

INrNDEX( I) 

K=I-1 

c 

r 


K 

= 

200 

SEQACI} 

K-5*I 

C 

INPUTS FOR ANY STD. CDMP. 

K 

S' 

63 

DINPUTd} 

K=I‘-1 

c 

r 


K 


63 

UINPUTtI } 

K=I-l (INCOM) 

U 

c 

OUTPUTS FOR ANY STD. CDMP. 

K 


63 

DGUTII} 

=:I-1 

c 

r 


K 

= 

63 

UOUTd} 

K=I»1 (INCOM) 

u 

c 

r 

TABLES PER STD;» COMP. 

K 


15 

TABLE(I) 

K=I (FILOAD) 

w 

c 

r 

TABLES PER MODEL 

R 

= 

100 

TABNAMJI) 

K=I (FILOAD) 

c 

c 

OPTIMAL CONTROLLER INPUTS 

K 

= 

63 

OCINPTd } 

K“I 

w 

C 

r 

OPTIMAL CONTROLLER OUTPUTS 

R 

s 

63 

DCOUTPCI} 

K=I 

V 

c 

c 

OPTIMAL CONTROLLER CRITERIA 

K 

- 

63 

OCCRITfl) 

R=I 

U 

c 

DESIGNED BY: J .D. BURROUGHS 

COMMON/CMSI/MSI{897)/C10/IREAD' 

DATE: MAY 1974 

flWRITE,IDIA G/CORD ER/NOX t NOV » NO P 


l/CTlTLE/TITLE{7)/CSEQ/NSEQ,SEQAl40)/CTAB/NOTABvTABNAMf 100} 
COMMON/COCINP/DClNPTt63)/CQCOUT/OCDUTP(63}/COCCRI/DCCRITt63} 
COMMON/COC/NOCINiNDCDUTTNOCtNDCMOD,NOCCRTLQCOC,IOCAN?IXOCrIUOC 
DIMENSION IC0M(8) rCHMNDS ( 21} , SOURCE { 8 } rOINPUT( 64 ) ,DOUT« 64 ) 
DIMENSION CMPNTS(151},CMPMOD{200) ,ININDEX{201) 

DATA NOCOMP/O/,ITASR/6/,IPUNCH/0/ 

DATA BLNK/lOH /,ICMMAX/21/ 

DATA CMMNDS/210HL0CATI0N INPUTS FORTRAN STEND OF MQDXXXXXXXXXX 
IMODEL DESCPRINT XXXXXXXXXXPUNCH DI AGNOSTICADD STATESADD VA 
2RIABADD PARAMEADD TABLESLIST STANDO.C. INPUTO.C. OUTPUO.C. QRDERO. 
3C. MODELO.C. CRITEO.C. ANALY/ 

IDIAG=0 

IREAD-5 

IWRITE=6 

WRITEdWRITEjlU 

11 FORMATt IHlrlOXr^INPUT COMMANDS*/} 
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c - 
c - 
c - 


20 

c 

100 

101 

200 
201 
c — 

205 
207 
C - 

c - 

3 00 
320 
C 

C -* 
C — 


c - 

325 
C - 


326 


328 

330 

335 


C - 
400 


-> OPEN STANDARD COMPONENT PILE 

CALL QPENMSC78, MSI, 897,1) 

~> OPEN MODEL COMPONENT INPUT FILE 

CALL 0PENMSt7|ININDEX, 201,0) 

-> OBTAIN STD. COMPONENT NAMES FROM PERMANENT FILE 

CALL READHST78,ICPMAX,1,6HCMPNTS) 

CALL RE A DMS 1 78 , CMP NT S , I CPM AX , 6HCM PNTS ) 

DO 20 I~2,ICPMAX 
CMPNTS( I“1)=CMPNTSU) 

ICPMAX:=ICPMAX-1 

READ DATA CARD 
READ tIREAD, 101 )ICOM 
FORMAT! 8A10) 

IF{ EOF! IREAD) >6260,200 
WRITE EIWRITE, 201 )ICOM 

FORMAT!/* COMMAND CARD > *,8A10) 

-> DIAGNOSTIC PRINTS 

IF(IDIAG-EQ-10)WRITE{IWRITE,205) (CMMNDSf I ) , I=1,ICMMAX} 

FORMAT!* C0MMANDS*/10!1X,A10>) 

IFtIDlAG.EQ.20>WRlTE!IWRITE,207){CMPNTSt I),CMPNTS!I) ,I=1,ICPMAX) 
FORMAT!* STD. CDMP0NENTS*/4( 1X,A10, 1X,020) ) 

ENDFILE IWRITE 

~> INDEX FDR DATA CARD COLUMN 

INDEX=1 

-*> LOCATE NEXT PHRASE 

CALL NXTPH{ICOM,INDEX,PHRS> 

IFtPHRS.EQ.8LNK) GO TO 100 
-> SEARCH COMMAND LIST 

CALL LCMPH{PHRS,CMMNDS,ICMMAX,lsNTASK) 

-> NTASK = NEW TASK INDICATOR 

IFtNTASK.NE.O) GO TO 400 

■“> TEST FOR DIRECT MODEL MODES AND O.C. INPUTS 

GO 10(325,325,5000,325,325,325,325,325,325,325, 

1 5100,5200,5300,5400,325,7000,7000,7000,7000,7000, 

2 7000), I TASK 

-> SEPERATE STANDARD COMPONENT NAME FROM SPECIFIC COMPONENT NAM 

COMP=BLNK 

CALL STRMOVtPHRS, 1,2, COMP, 1) 

-> SEARCH COMPONENT NAME LIST 

DO 326 IC0MP=1, ICPMAX 

IFtKQMSTRtCMPNTStICOMP) ,1,2,C0MP,1).EQ.0)GD TO 328 

CONTINUE 

IC0HP=0 

GO TO 330 

IF(ITASK.EQ.l) GO TO 1200 
GO TO 2000 

WRITE (I WRITE ,335) COMP 

FORMAT! /5X,34H *** WARNING *** CAN T IDENTIFY ,A10,*AS A STANDAR 
ID COMPONENT.*) 

IF{ITASK-EQ.2)G0 TO 300 

ITASK-6 

NEWC=0 

GO TO 300 

-> NEW COMMAND IDENTIFIED 

LTASK=ITASK 
ITASK=NTASK 
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IFfLTASK-EQ.3)WRITEi9,401) 

401 FORMATt+FDRT*) 

C > TESTS FOR UNFINISHED BUSINESS 

IFCLTASK-EQ.1.0R.LTASK.EQ.2} 60 TO 410 
C > BRANCH TO NEW TASK 

420 GO T0(1000?2000, 500, 4000, 4000*520, 6000f 100,5900, 1400p 

1 300,300,300,300,6300,300,300,300,300,300, 

2 7100),ITASK 


410 IFtITASK-EQ.2) GO TO 300 
GO TO 3000 

c x;=======:=:==i== FORTRAN STATEMENTS ITASK == 3 

500 NOCOHP-NOCOMP+1 

C ADD COMP. NO, TO COMPONENT SEQUENCE LIST 


NSEQ=NSEQ+1 

CALL PUTCOD{NSEQ,SEQA, NOCOMP) 

CMPMOD ( NOCOHP ) =4HF0RT 
GO TO 100 

C ==================== model DESCRIPTION ITASK = 6 

520 NEWC=0 
NOV=0 
NDX=0 
NOP=0 
N0C0MP=0 
NSEQ=0 
N0TAB=0 
NQCIN=0 
N0C0UT=0 
N0C=”1 
N0CMDD=-1 
N0CCR=0 
L0C0C=-1 
I0CAN=0 
IX0C=1 
REWIND 8 
REWIND 10 
REWIND 11 

C > LOAD TITLE 

DO 530 1=1,7 

530 TlTLEtn = 10H 
I=INDEX+1 
J=80-INDEX 

CALL STRMDV(IC0M,I,J,TITLE,1} 

GO TO 100 


Q > INITIATE NEW COMPONENT 

C ~> GET COMPONENT LOCATION NUMBER 

C ==================== LOCATION ITASK = L 


1000 CALL NXTPHaC0M,2NDEX,L0CND) 

CALL NUMERCILOCNO), RETURNS (1100> 

GO TO 300 

1100 WRITE(IWRITE,1101)L0CN0 

1101 F0RMATf/5X,18H WARNING ,A10,+ IS NOT A VALID LOCATION NU 

IMBER*) 

CALL ST RMOV { LOCND , 1 , 10 , PHRS , 1 J 

LDCNO=10H-100 

GO TO 320 
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1200 IFCNEWC-EQ-UGO TO 1220 

CAUL NEWCOMt PHRS> CMPNTS ? ICOMP * LOCNDtCMP«OD» NOCOMP t 
iDINPUTrNDINPUTrDQUTsNDQUTtlDCOHP) 

DCOMNAM=PHRS 
NEWC-l 
GO TO 300 

1220 WRITEtIWRITEsl221)DC0HNAH,PHRS 

1221 F0RMAT(/5X?28H WARNING COMPONENT jAlOf* DEFINITION WASN 
IT COMPLETED BEFORE STARTING THE DEFINITION OF COMPONENT ^,A10) 


ITASK=6 
GO TO 3000 

C ™=^=.==:== ============ diagnostic CONTROL ITASK = 10 

1400 CALL NXTPHtICQMs INDEX* PHRS) 

C CHECK FOR NUMERIC IPUT, SKIP INPUT IF WOT NUMERIC 

CALL NUMERCiPHRS}, RETURNS (300) 

C CONVERT TO INTEGER 

CALL BCDRELC PHRSjFKRS) 

IDIAG-PHRS 
GO TO 300 

C ==================== INPUTS ITASK = 2 

C TEST TO ASSURE THAT COMP. HAS BEEN IDENTIFIED. 

2000 iFCLTASK.EQ.6)GQ TO 300 
C — -> ADD INPUTS TO COMPONENT 

CALL INCOMtlCOM*PHRSf INDEX tND INPUT? DINPUT*NDOUT,DDUT* 

1 DCOMNAH,CMPMOD,NOCQMP, ICOMP i 
GO TO 320 

C > STORE INPUT LIST FOR COMPONENT 

3000 IF ( I DCDMP.GE.l. AND. IDCOMP.LE. NOCOMP. AND. ND INPUT. GT.O) 

1 CALL WRITMS(7,DINPUT?NDINPUTtIDC0HP) 

NEWC=0 
GO TO 420 

C ==================== end OF MODEL COMPILE ITASK = 4»5 

C > FORM MODEL SUBROUTINES 

4000 CALL ENDMOD(CMPMOD,NOCOHP*DOUT) 

60 TO (3 00, 300 » 300 ?300?6200 » 300*6000 ?100» 5900? 1400* 

I 300, 300, 300, 300, 300^, ITASK 

C > WRITE FORTRAN ONTO SOURCE FILE 

5000 WRITEt9,10UIC0M 
GO TO 100 

C =================== ADD STATES ITASK - U 

C —> ADD STATES TO MODEL 

5100 WRITE{8,10UPHRS 
NOX=NOX-i-l 
GO TO 300 

C =================== add VARIABLES ITASK - 12 

C > ADD VARIABLES TO MODEL 

5200 WRITEdlrlODPHRS 
N0V=NQV+1 
GO TO 300 

C =================== add PARAMETERS ITASK = 13 

C > ADD PARAMETERS TO MODEL 


5300 WRITEQOrlOUPHRS 
NDP=NQP-f-l 
GO TO 300 
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C ==r:=:===;s==:==:^=:=:===;=:= ADD TABLES ITASK = 14 
C > ADD TABLES TD MODEL 

c — > get table dimension in next phrase 

5400 CALL NXTPH£lCOM,INDEXfTABDIM} 

C > TEST TO ASSURE THAT TABLE DIMENSION IS NUMERIC 

CALL NUMERCfTABDIM)yRETURNS{5420> 

C > CONVERT TABLE DIMENSION TO INTEGER 

CALL BCDREL£TABDIM,TABDIM) 

I=TABDIM 

CALL PUTC0D£5,PHRS,I> 

NOTAB=NOTAB-t-l 
TABNAMC NOTAB }=PHRS 
GO TO 300 

5420 WRITEtIWRITE,5421JPHRS,TABDlH 

5421 F0RMAT(/5Xt29H WARNING =*^=^^=4^ TABLE NAME ,A7, 

1* MUST BE FOLLOWED BY A NUMERIC DIMENSION RATHER THAN *»A7) 
PHRS=TABDIM 
GO TO 320 


C > SET INDICATOR TO PUNCH SOURCE DECKS 

c =;:=====“===:==:======= PUNCH ITASK =9 

5900 IPUNCH=1 

C «=========:=«===== print ITASK = 7 

C > DRAW SCHEMATIC DIAGRAM 

6000 CALL SCHEMA£CMPMOD?NOCOMP,DINPUT,DOUT) 

C > PRINT INPUT REQUIREMENTS LIST 


REWIND 12 
WRITE(1WRITE,6161) 

6161 FORMATUHl) 

6170 READC12,101>SOURCE 

IF£EOF( I2>)6200,6180 

6180 WRITEUWRITEt6iax ^SOURCE 

6181 F0RMAT£1X,7A10,A2) 

GO TO 6170 

C > PUNCH SOURCE FILE 

6200 IF{IPUNCH.NE.1)G0 TO 100 
REWIND 9 

6220 READ C9» 101 )SOURCE 
IF(E0FC9)}100,6250 
6250 HRITEt3f lOllSOURCE 
GO TO 6220 
6260 STOP 


c =~=====:==:====:=====T LIST STANDARD COMPONENTS ITASK =: 15 
6300 CALL LISTSC{ICPHAX,CMPNTSjDINPUT,DOUT) 

GO TO 300 

c Q.C. COMMANDS ITASK 1 6 , 17 , 18 , 19? 20 , 22 

C > INTERPRETE OPTIMAL CONTROLLER INPUTS 

7000 CALL OCINTRi ITASK?PHRS) 

GO TO 300 

C -===t=;=s======-===:==:5 O.C. ANALYSIS ONLY ITASK = 21 

C > SEX ANALYSIS ONLY FLAG 

7100 lOCAN^l 

GO TD 300 
END 
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CENDCQM 

SUBROUTINE ENDCOM { Al NPUT » COHN AH , SOURCE SOUR jNOCOMP?NSEQ J 
VERSION 2. REVlSEDt DEC 15 1975 

purpose: to COMPLETE A COMPONENT DESCRIPTION IN THE ECS MODEL* 

CALL SEQUENCE AINPUT - LIST OF INPUT QUANTITY NAMES 

COMNAH - SPECIFIC COMPONENT NAME 
SOURCE - BUFFER ARRAY OF SOURCE CODE 
ISOUR ~ INDEX TO NEXT CHARACTER IN SOURCE BUFFER 
NOCOMP “ MODEL COMPONENT NO. 

NSEQ - MODEL COMPONENT SEQUENCE NO. 

DIMENSION AINPUTtllsSOURCEtS) 

CDMMON/CIQ/IREAD? IWRITE j IDIAG 
COMMON /CORDER/NOX,NOV,NOP 

DATA COMMA/1 OH ^ /,RPAR/10H) /rBLNK/lOH / 

CALL GETCaDI5,C0HNAM,NINPUT) 

TEST FOR COMPONENTS s^ITH NO INPUTS 

IFCNINPUT.LE.OJGO TQ 110 
CALL READMS{75AINPUT,NINPUT*N0C0MP) 

> SCAN INPLITS 

DO 200 I=I,NINPUT 

> TEST 4TH CHARACTER TO DETERMINE IF INPUT SOURCE HAS SEEN SAT 

CALL GETT{AINPUTm*4,CHAR) 

1F(CHAR.NE.BLNK> GO TO 100 

> NOT STAISFIED - TYPE INPUT AS A PARAMETER 

> FORM UNIQUE NAME BY ADDING COMPONENT NAME 

CALL NAMGENCAINPUTU) jCOMNAM,AINPUT(I)} 

> INCREASE PARAMETER COUNTER 

NOP-NQP+1 

> ADD NAME TO PARAMETER NAME LIST 

WRITEllOjIDAINPUTtI) 

1 FQRMATCAXO) 

> ADD INPUT TO COMPONENT CALL SEQUENCE 

100 CALL LINECOiSOURCE, ISOUR, COMMA, 1,12) 

CALL LlN6(0,SOURCE,ISOUR,AINPUTiI),7,12I 

200 CONTINUE 

C — > COMPLETE CALL SEQUENCE WITH ) 

110 CALL LINE{0,S0URCEtISQUR,RPAR,l,x2) 

IF(IDIAG.GE.50)WRITE( IWRITE, iOl) SOURCE 

101 FORMATE* ENDCOM“SOURCE*/{lX,6AIOl ) 

C > WRITE LINE ON SOURCE FILE 

WRITE(12,201)S0URCE 

201 FORMATE 8A10) 

C > GENERATE STATEMENT NUMBER 

ND=NSEQ+9000 

C > WRITE CONTINUE STATEMENT ON SOURCE FILE 

WRITEE12,205)NQ 

205 FORMATE IX, 14, IX, ^CONTINUE*) 

RETURN 

END 
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CENDMOD 

SU3RQUT INE ENDMQD CCMPMDD, NDCOMPtOUTPUT) 

C VERSION 4*1 REVISED JUNE 28 1977 

C PURPOSE 1 COMPLETE THE GENERATION OF ECS MODEL SUBROUTINES EQMQ DAT 
C CALL SEQUENCE: CMPMOD - ARRAY CONTAINING NAMES OF MODEL COHPS- 

C NOCDHP - COMPONENT COUNTER 

C OUTPUT - INPUT-OUTPUT-TABLE NAME ARRAY WORK SPACE 

C DESIGNED BY: J*D» BURROUGHS DATE: JULY 1974 

COMMON/CORDER/NOXsNDV,NQP/CTITLE/TITLE{7)/C5EQ/NSEQ,SEQAUl 

1 /CTAB/NQTA8,TABNAH41)/COC/NOClNfNQCOUTvNOCjNOCMaD,NOCCR*LOCCOCt 

2 IOCANtIKDC 

COMMON/C lO/IREAD, INRITE r ID lAG 

DIMENSION IVRSET{160i,XSOUai8JTGTt2)9CHPMODU)jOUTPUTU) 

DATA GT/20H GO TO( /,ECS/10HECS / 

DATA CYCLES/12HCYCLES /,DLINES/12HDLINES /» 

1 RESET/ 12HRESET / 

REWIND 12 
REWIND 9 

C GET PERMANENT FILE NAME 

CALL RE A DMS { 78 j PFNAME ? 1 , 6H PFMAME ) 

IFE IDIAG-EQ.21)WRITEi IWRITE,21) tCMPMODlI > tI=1?NOCOMP) 

21 FORMATpi' CMPMOD */10tlX*A101 > 

C > COMPLETE OPTIMAL CONTROLLER SPECIFICATION 

CALL OCENDENOCOMPjCMPHODjOUTPUT) 

IFE NOCDHP. LE«0) GO TO 90 

C > CHECK COMPONENT SEQUENCE FOR IMPLICIT EQUATIONS 

CALL COMORO t CMPMOD, NOCOMP, OUTPUT) 

C > SCAN MODEL COMPONENTS IN SEQUENCE OF LOCATION STATEMENTS 

DO 80 I=1,NSEQ 

C > GET COMPONENT NO. IN LOCATION SEQUENCE 

CALL GETCODE I,SEQA,ICOHP) 

C > TEST FOR DIRECT FORTRAN COMPONENTS 

IF{CMPH0D<IC0MPJ.EQ»4HF0RTiG0 TO 60 
IF( I. EQ.l) WRITE (12,31) 

31 F0RMATt6X,*IF{CPUS.EQ.CPUSEC)GQ TO 9000* ,/6X,*S'ITEST = 0* , 

1/6X,*IF( RESET. GT-0.mEST=L*,/6X,+CPUS=CPUSEC*,/6X,*ICNT=0*, 
2/6X,*IMPL=0*,/lX,*9000 CONTINUE*) 

C > test for O.C. IF YES CALL OCCALL 

IF(KOMSTR(CMPHDDtICOMP),i92,2HQC,l).EQ.O)GO TO 72 

C > INITIATE COMPONENT SUBROUTINE CALL GENERATION 

CALL CALLCPtCMPMODtlCOMP) , ICQMP,XSOUR, IS OUR , IVRSET, OUTPUT ) 

C > COMPLETE COMPONENT SUBROUTINE CALL GENERATION 

CALL ENDCaMtOUTPUT,CMPHODaCOHP),XSOUR,ISOUR,ICQMP,n 
GO TO 80 

C > TRANSFER DIRECT FORTRAN FROM FILE 9 TO FILE 12 

60 R6ADt9,61)XS0UR 

61 FORMAT I 8A10) 

C > TEST FOR EOF 

IF(EOF(9))S0c70 

70 IF(KOMSTR{XSOUR,l,4,4HFORT,U.£QcO)GO TO 74 

WRITEtl2,6i>XSDUR 
GO TO 60 

72 CALL OCCALLtCHPMO’^,NOCaMP,l,IVRSET, OUTPUT) 

74 IF(I.EQ-l)WRITt(12f3l) 

80 CONTINUE 
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REWIND 9 


90 


ADD PARAMETERS CYCLESjDLINESjRESET 

WRITE ( 10 t81>CYCLES»DHNESjRESET 
81 ‘FORMAT U 10) 


N0P=N0P+3 

c ==-======> PQRH SUBROUTINE EQMQ 

N0XP=MAX0!N0K,1) 

WRlTE(9,9nTlTLE9PFNAME,NOXP»NaXP 

91 FORMAT 1 6X?^SUBR0UTINE EQM0^TIME^TSTEP,INDPI=f=/=^'C=!=/*Ci‘,9X,7A10/i^'C=^/ 


l:^Q — this subroutine was prepared by THE EASY PRECOMPILER* 
2/*C*,2BX>*USING *,A10,* COMPONENTS* 

2/6X**CQMMON/CXDDT/XDOTt*» X4,*)/CINT/INT{*rI4#*)* 

3 / 6 X 9 *C0MM0N/CS1MUL/DUM ( 6 ) 9 TI NC ,TMAX , DUM2 ( 6 ) * 
3/6Xs*C0HM0N/CIMPL/IHPL»ICNT9lTEST/C0VRLY/ADUM(3) fCPUSEC*, 

4/6X 9 *C0 HMON/CO ST/CCO 1 9 ) * ) 

IFCNDX^LT-1) GO TO 105 
C form /CX/ COMMON 

WRITE^9993) 

93 FORMAT (*C > STATE VARIABLES*) 

CALL COMGEN(NOX,2HCX»899> 

105 IF(NOV.LT.l) GO TO 120 
FORM /CV/ COMMON 
WRITEC99XUJ 

111 FQRMAT(*C > VARIABLES’i^) 

CALL COMGEN(NOV52HCVsll99) 

120 IF(N0P»LT.1> GO TO 140 

C > FORM /CP/ COMMON 

WRITE{9,12I> 

121 FORMAT(*C > PARAMETERS*) 

CALL COMGEN«NOP,2HCP910t9J 

C -»-> generate TABLE COMMON IN EQMO 

140 CALL TABGEN 

C > GENERATE 0«C- COMMONS 

IF(IOCAN*GT.OJCALL OCCOM 
riRITE{9,151) 

151 FORM AT I *C > MODEL EQUATIONS*) 

C > TRANSFER CALL SEQUENCE FILE ONTO PROGRAM FILE 

REWIND 12 

350 READU2961 JXSOUR 

IFtEOFtlZ) )400,37C 
370 WRITEt9,6l)XS0UR 
GO TO 350 

Q — WRITE RETURN AND ENTRY VARSET AT END OF SUBROUTINE 

400 WRITE{9f401) 

401 FORMAT! 6X»*C ALL IMPLIC !CYCLEStDLlNES)*,/6X, 
l*IF(CYCLES.LT«l.)GD TO 9900*T/6X,*IFnMPL.LT.4)G0TO 9000*, 
2/6X,*IMPL=l*,/lX,*9900 CONTINUE*, /6X9*RETURN*,/6X, 

3*ENTRY VARSET*) 

C > IVR = 2 FOR VARIABLES. IVR 0 FOR STATES. 

IVR=2 

C > TEST THAT THERE ARE VARIABLES IN MODEL 

IFtNQV.LE.O) GO TO 620 

C test for more THAN 244 VARIABLES 

IF { NOV . GT. 244) WRITE 1 9 , 41 1 > IVR 
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411 FORMAn6X,*IFlINDP.ST-244)GO TO 1000*,I1J 

C > LOAD XSDUR WITH GO TO{ 

420 XS0UR{1)=GTU) 

XS0UR(2}~GTt2J 
DO 500 1=3 fS 

500 XSDUR(I)=1QH 
IXS0UR=13 
NGT=0 

C > SCAN COMPONENTS 

DO 600 I=1tNDCQHP 

> GENERATE STATEMENT NO, CORRESPONDING TO EACH COMPONENT 

ISN=9000-i-I 

£ ™ — > CONVERT ISN TO BCD FORMAT 

ENCODE(4»501,ISNJISN 

501 FDRMATCI4) 

C — ^-> INDEX FOR THE NO* OF VARIABLES CSTATBSl BEFORE COMPONENT WAS 

CALL GETCODCItSEOAjICOMP) 

J=4*IC0MP-IVR“1 

CALL GETCODtJjIVRSETjNOJ 

Q > INDEX FOR THE NO* OF VARIABLES (STATES) AFTER COMPONENT WAS 

J=:4+IC0MP-IVR 

CALL GETCODT J,IVRSET,N1) 

c ^ — > test to determine IF ANY VARIABLES (STATES) WERE FORMED 

iF(Nl.LE.NO} GO TO 600 
NO=NO+l 

C > SCAN THE NO* OF VARIABLES (STATES) FOR THIS COMPONENT 

DO 520 J=NOfNl 
NGT=NGT+1 

C test IF 2ND LEVEL OF GO TO IS REQUIRED 

IF(NGT-LE#244)G0 TO 515 

CALL LINE{0*XSaUR,IXSOUR»6H)5lNOP*6,9) 

WRITEt9,61)XSQUR 

WRITE(9,51UIVR 

511 FDRMAT(41000=«'f INDP = INDP-244^) 

XSQUR(l)-GTtl) 

XS0UR(2>-GT(2) 

DO 505 K=3»8 

505 XS0URCKJ=10H 
IXS0UR=13 
NGT=0 

515 IFdXS0UR.NE.13) CALL L1NE( OsXSOUR? iXSDURslH? 9) 

C •> PLACE STATEMENT NO* IN COMPUTER GO TO STATEMENT 

CALL LINEtO,XSOUR*IXSOUR,ISN«4j9) 

520 CONTINUE 

600 CONTINUE 

Q > COMPLETE GO T0( STATEMENT 

CALL LINet07XSOUR*IXSOUR,6H)»INDP?6»9> 

WRITEt9,6l)XS0UR 
IF(IVR.LE.O) GO TO 700 

620 IVR=0 

WRITE(9»60n 

601 F0RMAT(6X,*i'ENTRY RATSET*) 

C -- -> TEST THAT THERE ARE STATES IN THE MODEL 

IFtNOX.LE.O) GO TO 700 

Q „„ XESX IF 2ND LEVEL OF GO TO IS REQUIRED FOR RATES 
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IFlNDK.GT.24^t)WRITEl9f4U)IVR 
GO TO 420 

C ==p:=i™»=:=> FORM SUBROUTINE DATAIN = 

e COMMON AND DIMENSION STATEMENTS 

700 WRITE(9f701)TITLE 

701 F0RMAT(6X,^END*/////6XT*SUBR0UTiNE DATAIN:^=/’t=C 9X j7AlO/*C*/ 

1*C THIS SUBROUTINE WAS PREPARED BY THE EASY PRECOMPILER^/ 

26X» ^COMMON/CORDER/NOX itNDV , NOP^ J 

C > TEST IF STATES ARE PRESENT IN MODEL 

IF(NOX,LT.ll GO TO 715 

C ■> PORM STATE RELATED COMMONS 

WRlTE(9»7linN0Xf I=i,10J 

711 F0RMATC=4^C > STATE RELATED COMMONS’f^/ 

16X,*COMMON/CX/X{*,I4,^J/CXDOT/XDaTt*»I49=S')/CXlC/XICt’J^,I4,*)=«‘/ 
25X,*I /CXrCl/XICl{=J=tI4,=^=)/CXIC2/XIC2C*9l4,s4f)/CXIC3/XIC3{=5'9l4j*)4:/ 

35'A,^2 /ClNT/INT{=«=,I4,*)/CNAMEX/NAMEX{*,I4,*)/CNAMER/NAMER{’«f,l4y=«=)* 
4/5Xj*3 /CNTRLS/AN,IPRNT,MODEfERROR{*, 14, =?:)*) 

C > CALCULATE THE AMOUNT OF WORK SPACE REQ D. 

715 N0-N0X*t2*N0X+7) 

IFINO.LT.1000)NO=1000 

WRITEC9,719IN0 

719 FDRMAT( 6X,*C0MMDN/CW0RK/CW0RK£*,I5»*J*i 
C > TEST IF VARIABLES ARE PRESENT IN MODEL 

740 IFINOV.LT.U GO TO 780 
WRITE C9, 741 )NDV,NOV,NOV 

741 FOR«AT(*C > VARIABLE RELATED COMMONS^/ . 

16X**C0MM0N /CV/V{*?I4,*)/CNAMEV/NAMEVt I4»*)/C0 LD/VOLD {*, 14,* )* ) 

C > TEST IF PARAMETERS ARE PRESENT IN MODEL 

780 IFtNOP»LT«lI GO TO 800 
WRITE{9»78UN0P,NDP 

781 FORMAT{*C > PARAMETER RELATED COMMONS*/ 

16X,*C0MM0N /CP/P(*,I4t*}/CNAMEP/NAMEP(*,I4,*}*J 

C > LOAD NO. OF STATE# VARIABLE, AND PARAMETERS INTO COMMONS 

800 WRITEC9s821)N0XsN0V,N0P 

821 FORMAT(*C > SET NO. OF STATES, VARIABLES, AND PARAMETERS*/ 

16X « *NOX=* , I4/6X s *NOV=* , I4/6X , *NOP -* # 1 4 J 
IFfNQX-LE.O) GO TO 850 

C ~> LOAD STATE ERROR AND PARAMETER DEFAULT VALUES INTO COMMONS 

WRITE {9, 831) 

831 F0RMAT(’4^C > LOAD STATE ERROR DEFAULT VALUES*/ 

16X,*D0 100 I-1,N0X*/6Xt*ERR0R(I)=«1*) 

IF£PFNAMEoEQ^ECS)WRITE(9,833) 

833 F0RMAT{6Xt*CALL GETTCNAMEXC I ) ,1,KAR )*/6X ,*IF { KAR • EQ* IHT) ERRDR( I ) =1 
3.*/6X,*lF{KAR.EQ,lHP)ERR0R{ I }=.005*) 

WRITE (9, 841) 

841 FDRMAT«*100 CONTINUE*) 

850 IFJNOP.LE.O) GO TO 860 
WRITE{9,851} 

851 FORMAT{*C > LOAD PARAMETER DEFAULT VALUES*/ 

16X,*D0 300 I=I,N0P*/*300 P { I )-, 99999*/ 

26X,*WRITE( 6,301 )*/*301 FORMAT! IHl )*) 

860 REWIND 12 

C > START FORMATION OF INPUT REQUIREMENTS LIST 

WRITE{12,861)TITLE,NQCDMP,N0TAB,NDP,N0X,N0V 

861 FOaMAT£//iOXp7A10//3X,*THIS MODEL CONTAINS *,I4,* COMPONENTS*/ 
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X5X,=i=WITH: TABLES=3^t2X, PARAMETERS*?2Xf STATES AIMD'^^ 

22X,I4,=J^ VARIABLES 

2//10X,=3"INPUT DATA REQUIREMENTS LIST^/) 

MAXT-0 

ZFCNDTAB.LE^OJGO TO 864 
CALL TA8CAL 


C ===i=“t.===5:-=:= COMPLETE DATAIN SUBROUTINE START BLOCK DATA MODEL 

G CALCULATE TOTAL STORAGE REQUIRED BY MODEL TABLES 


DO 862 I^ljNOTAB 

CALL GETCDD{5,TABNAM(I) »N} 

MAXT=MAXT+IABS^N) 

862 CONTINUE 

C TESTS TO PREVENT DIMENSIONS < 1- 

864 NOVP=MAXO{NOV,1J 
NQPP=HAXO{NQP,X) 

MAXTP=MAX0(HAXT,1) 

NOTAB P=M AX 0{ NOTAB , 1 ]| 

WRITE(9,865jNDXPtNQVP,N0PP,MAXTP,N0TABPtN0TABP,NQTABP 

865 FORMAT! 6X»*RETURN*/6X,>f=END*//// 

16X,=4'BL0CK DATA MQDEL*/*C > MODEL NAME CDMMQNS=J=/ 

26Xt*CDMMQN/CNAMEX/NAHEX«>i',I49*)/CNAMEV/NAMEVf=«'9l4r 

3>«')/CNAMEP/NAMEP(*tI4f»i=)=J=/5X**l/CTABLE/TABLES(*,I49=5'}/CTABNA/TABWAM 

4(«,I3»*)+/ 

55X,*2/CMAXDI/NOTAaTMAXDIM!=4=9l3,^}/CLOCTA/LOCTAB(^,I3j*>=J=) 


C > CREATE EQUIVALENCE STATEMENTS IF NEEDED TO ALLOW DATA 

C > STATEMENTS TO LOAD NAME LISTS EXCEEDING 130 NAMES 

CALL CDMEQUfSHNAMEXvNOX) 

CALL C0MEQUC5HNAMEV,N0V) 

CALL C0MEQU(5HNAMEPiNDP) 

C s====s^== add FLIGHT CONDITION PARAMETER VALUES fECS APPLICATION) 

IFt PFNAME. EQ. ECS) WRITE C9t 866} 

866 F0RMAT{6X,*CQMMQN/AM:ISS/PAMBjTAMB,PRAH,TRAM,ALTsAMN=^) 

C > TEST FOR Q.C» IF YES CALL OCBLKD 

IFilOCAN^GTcOJCALL OCBLKD 

C > GENERATE NAME DATA STATEMENTS 

WRITE199867) 

867 FORMAT! «=C > MODEL DATA STATEMENTS*) 

C > GENERATE STATE, VARIABLE, AND PARAMETER NAME DATA STATEMENTS 

CALL NAMARY!5HNAMEX,5,NaX,S> 

CALL NAMARYf 5HNAHEVr5,N0V,li) 

CALL NAMARYt5HNAMEP,5,NOP,10) 

C > CALCULATE NO- OF WORDS IN TABLES 

C GENERATE TABLE NAMES, MAX DIMENSIONS, LOCATIONS 

CALL TABDAT 

C ======= add flight CONDITION PARAMETER VALUES (ECS APPLICATION) 

IF (PFNAME-EQ.ECS)WRITE (9,868) 

868 FORMAT! 6X,*DATA PAMB, TAMB, PRAM,TRAM, ALT# AMN/14.69, 519- , 14- 69, 519. , 

1 0.,0./*) 

C ========== TABLE INITIATION FOR ALL MODELS 

WRITE(9,8691MAXTP 

869 F0RMAT(6X,*DATA TABLES/*, 15 # 9H*I . 99999//6X # *END*///) 

IF(NOP.LE.O) GO TO 960 

C > ADD PARAMETERS AND STATES TO INPUT REQUIREMENTS LIST 

NUNIT=I0 

N1=N0P 

WRITE(12,881) 
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881 F0RMAT{///14X,*PARAMETERS REQUIRED>i^// 

1 13X » =}^CGM PONE NT* » 5X , ’►PARAME TER+/ 

2 15X I *NAM E* , 1 OX , *NAME* ) 

900 REWIND NUNIT 
GOMPS^lOH 

DO 940 1=1, N1 

G -^> SCAN PARAMETER (STATE) LIST 

READ (NUNIT, 901) ANAHE 

901 F0RMATU7) 

CALL STRM0V(ANAME,4,4sCDMP,l) 

C COMPARE CURRENT COMPONENT NAME WITH PREVIOUS NAME 

IF(COMPS-EQ-CaMP) GO TO 920 
WRITE(12,91i> 

911 FORMATCIH ) 

COMPS=COMP 

920 WRITE{12,921)C0MP,ANAME 

921 FORMATt 15X,A4,9XrA7) 

940 CONTINUE 

960 IFtNQX.LE.O) RETURN 
IF(NUNIT-EQ.8) RETURN 
NUNIT=8 

N1=NQX 

WRITEfl2,961) 

961 FORMAT! ///18X,*STATES*/ 

12X,*{ INITIAL CONDITIONS AND ERROR CONTROLS REQUIRED)*// 
213X,*C0MP0NENT*,6X,*STATE*/15X,*NAME*,10X,*NAME*) 

GO TO 900 
END 
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CHLINE 

SUBROUTINE HLINE ( PAGE sLINE, IN» IR } 

PURPOSES ADD A HORIZQE^TAL CONNECTION LINE TO ECS SCHEMATIC 
CALL sequence: PAGE - X3X56 ARRAY CONTAINING HOLLDRITH 

REPRESENTATION OF A PAGE 
LINE ~ LINE NO« FOR HORIZONTAL LINE 
IN INPUT COMPONENT COL- LOCATION 
IR - RECEIVING COMPONENT COL. LOCATION 
DIMENSION PAGEU3,56> 

C > IS INPUT COMP- ON LEFT DR RIGHT 

IFCIN.GE.IRJGO TO 100 
POINT-1 0H> 

11- IN 

12- IR 

GO TO 200 

C INPUT IS ON RIGHT 

100 P0INT=10H< 

I1=IR 

I2=iIN 

C > place point ON RECEIVING END OF LINE 

200 CALL PUTT( PageUp LINE) ? IRfPQINTJ 
C ADO NO- OF SYMBOLS REQ D- TO SPAN COLUMNS 

DO 300 1=11,12 

C > TEST TO PREVENT OVERWRITING POINTS 

IF{K0MSTR{PAGEatLINE)9l,l,lH<,i) -EQ.OGO TO 300 
IFtK0MSTRCPAGEU8LINiEi,I»l,IM>,ii -EQ»0)GO TO 300 

C ^ > ADD HORIZONTAL LINE SYMBOL 

CALL PUTTiPAGECljLINE), I,1H=) 

300 CONTINUE 
RETURN 
END 
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CUBIT 

FUNCTIDN lJBIT{A>Ira,N) 

C VERSION 1. REVISED: AUG 7 1975 

C purpose: set UBIT EQUAL TO THE I J ELEMENT IN BIN ART ARRAY A 

C CALL sequence: A - N X N BINARY ARRAY 

C I ~ ROW INDEX 

C J - COLUMN INDEX 

C N - COLUMN DIMENSION OF ARRAY 

C DESIGNED BY: J.D, BURROUGHS JULY 1975 

DIMENSION At 1} 

IBIT=I+tJ-l)*N 

IWORD=UBIT-1>/60+1 

LBIT=M0D(IBITr60) 

Il“l - 

ASHIFT=SHIFT(A{IW0RDWLBIT} 

IJBI7=ASHIFT-AND.I1 

RETURN 

END 
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C X JBX T1 

SUBROUTINE IJBITl I A,I , J tN ) 

VERSION 1. revised: AUG 7 1975 

PURPOSE: LOAD 1 IN I J LOACTION OF N BY N BINARY ARRAY A. 

CALL sequence: A - N X N BINARY ARRAY 

I - ROW INDEX 
a - COLUMN INDEX 
N - COLUMN DIMENSION OF ARRAY 
DESIGNED by: J.D. BURROUGHS JULY 1975 

DIMENSION Atl) 

IBIT"I+( J-1)*N 
IWQRD=tIBlT-l)/60-H 
LBIT=60-M0DC IBITr60> 

I1“L 

I2-SHIFTfIl,LBIT) 

A(lWORD>=A{IWORD) ,0R.I2 
RETURN 
END 
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CINCOM 

subroutine INCDM{ICOH>PHRS>INDEX,NDINPUTyDINPUT,NDDUT, 
IDQUT,DCDMNAM,CMPMOD,NOCDMP,ICQMP) 

VERSION 3. REVISED: UUNE 27 1977 

PURPOSES PERFORM INPUT-OUTPUT CONNECTIONS BETWEEN STD. COMPS, 

CALL SEQUENCE: ICDH - COMMAND STRING ARRAY 

PHRS - CURRENT PHRASE (UPSTREAM COMP. NAME UPON ENT 
INDEX - COMMAND STRING CHARACTER INDEX 
NDINPUT- NO. OF INPUTS FOR DOWNSTREAM COMP- 
DINPUT - LIST OF INPUT QUANTITY NAMES FOR DOWNSTREAM 
COMPONENT 

NDOUT - NO. OF OUTPUTS FOR DOWNSTREAM COMP. 

DOUT - LIST OF OUTPUT QUANTITY NAMES FOR DOWNSTREAM 

DCOMNAM- SPECITIC COMPONENT NAME OF DOWNSTREAM COMP. 
CMPMOD - LIST OF COMPONENTS IN CURRENT MODEL 
NOCOMP - NO. OF COMP- IN CURRENT MODEL 
ICOMP - UPSTREAM COMP. TYPE 
COMMON /CI0/IREAD,H*RITE,IDIAG 

DIMENSION ICOM{8>,DINPUT(U»DOUT(l) ,UINPUT(64) ,UOUT { 64 1 ? CMPMOD { 1 > 

C > NO. OF CONNECTIONS INDICATOR 

N0CDN=0 

C > SAVE UPSTREAM COMPONENT NAME ' 

UCOMNAM=PHR$ 

C > gEX list OF UPSTREAM COMP. OUTPUTS 

CALL COMDATCUCOMNAM»4HOUTP»NUOUT,UQUT) 

Q > SCAN COMP. IN CURRENT MODEL 

DO 100 r-i,NOcnMP 

I C > TEST TO SEE IF UPSTREAM COMP. HAS BEEN DEFINED 

IFtK0HSTRtCMPMDDU>,l,4,UCDMNAH,X>.EQ-0>G0 TO 120 
lOQ CONTINUE 

C > GET STD. INPUT LIST FOR UPSTREAM COMP. 

I CALL C0MDAT{UC0MNAM,4HINPT»NUINPUT,UINPUT) 

i c > STORE COMP. LOC.--10O, COMP TYPE* NO. INPUTS FOR UPSTREAM CO 

I CALL PUTCaDt3TUCDMNAM,“100) 

CALL PUTC0D(5tUC0MNAM»NUINPUT) 

I C > INCREMENT MODEL COMP- COUNT 

NOCDHP=NOC0MP+1 

C > ADD COMP. NAME TO CURRENT MODEL LIST 

CMPMOD t NQCOMP )=UCOMNAM 

IUCOMP=NOCDMP 

GO TD 140 

C — -> GET INPUT LIST FOR EXISTING COMP. 

120 lUCQHP-I 

CALL GETCaDt5,CMPMDDUJ,NUINPUTi 
g _— > JEST FOR COMPONENT DRIVING ITSELF 

lF(KDMSTR(UC0MNAM,l,4,DC0MNAMr U.EQ.0}G0 TO 130 

C > GET INPUT LIST FROM FILE 7 

UINPUK U“3HZZZ 

IFINUINPUT.GT.OCALL READMS{7,UINPUT,NUINPUT,IUGDMP) 

GO TO 140 

C’ -> LOAD UPSTREAM INPUTS FROM DOWNSTREAM INPUTS LIST 

130 DO 135 I-1,NUINPUT 
135 UINPUK I >=DINPUT(Ii 

C *— > DEFAULT ON PORT DESIGNATION IS BLANK (UNIVERSAL PORT) 

140 UP0RT=1H 
' DPORT-IH 
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M0DE=1 

CALL NXTPHtICOM, INDEX, PHRS) 

IFtKaMSTRtPHRS,l,l,lH ,1>.EQ.0)GQ TO 500 

C ™> TEST FOR NUMERIC, I*E^ PORT NUMBER 

CALL NUMERC(PHRS), RETURNS? 180) 

C > SAVE NUMERIC PORT NO. 

MODE-1 

UPORT=PHRS 

CALL NXTPH?ICOM, INDEX, PHRS) 

IF(K0MSTRCPHRS,I,1,LH ,11-EQ.O>GO TO 160 

C > test for NUMERIC, I-E* PORT NUMBER 

CALL NUHERC? PHRS), RETURNS (160) 

C > SAVE DOWNSTREAM PORT NO. 

DPQRT=PHRS 
IPHRS=0 
GO TO A20 

160 WRITE (I WRITE, 161 )PHRS,UCOMNAM 

161 FORMAT? /5X,18H WARNING ,A10s*I$ NOT A VALID PORT DESlGNAT 

IION FOR INPUT COMPONENT ERRONEOUS CONNECTIONS MAY OCCUR 

Z^) 

GO TO 420 

C > SCAN UPSTREAM OUTPUTS 

180 DO 200 I=1,NU0UT 

IFtKOMSTRCUDUT?!) ,1,3,PHRS,1)*EQ.O)GO TO 220 
200 CONTINUE 
GO TO 500 

C — -> SAVE OUTPUT NAME 

220 UOUTNAM=UOUT?I) 

H0DE=0 

CALL NXTPHUCOM, INDEX, PHRS) 

CALL NUMERC? PHRS), RETURNS? 240) 

C > SAVE UNSTREAM PORT N0« 

UPORT=PHRS 

CALL NXTPHCICOM, INDEX, PHRS) 

C > SCAN DOWNSTREAM INPUTS 

240 DO 260 I-1,NDINPUT 

IF?KOMSTR(DlNPUTm, 1,3, PHRS, 1)-EQ-01G0 TO 280 

260 CONTINUE 

WRITE (I WRITE, 261) PHRS, DCOMNAM 

261 FORMAT? /5X,18H WARNING *** ,A10,*IS NOT A VALID INPUT QUANTIT 

lY DR PORT DESIGNATION FOR COMPONENT *,A4) 

GO TO 560 

280 DINNAM-DINPUT? I) 

CALL NXTPHUCOM, INDEX, PHRS) 

CALL NUMERC! PHRS), RETURNS? 300) 

DPORT=PHRS 

IPHRS^O 

C > SEARCH FDR MATCH BETWEEN NAMES PORT NO. GIVEN ABOVE 

300 DO 380 I=1,NDINPUT 

C > TEST FOR NAME HATCH 

IF{K0MSTR?DINPUT?I),1,3,DINNAM,1) .NE.O)GO TO 380 

C > BYPASS PORT TEST IF PORT NOT SPECIFIED 

IFtDPORT.EQ.lH >G0 TO 320 

C > DOWNSTREAM PORT TEST 

iF?K0MSTRtDINPUT{n,9,l,DP0RT9lJ.NE.0)GD TO 380 
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Q > SCAN UPSTREAM OUTPUTS 

3Z0 DO 360 J-lrNUDUT 

C > TEST FOR NAME HATCH 

IF{KOMSTREUOUTtJ>?l*3tUOUTNAMjl).NE.OJGO TO 360 

C > T5ST IF PORT IS SPECIFIED 

IFtUPDRT.EQ.lH )GO TO 400 

C > TEST FDR PG^T MATCH 

IFlKOMSTRtUOUTC JJ »9»l,UP0RT*l)-EQ-0tG0 TO 400 

360 CONTINUE 
380 CONTINUE 
GO TO 560 

C > SATISFY SPECIFIC INPUT 

C > get UPSTREAM AND DOWNSTREAM PORT NOS* 

400 CALL GETTCUDUT(U) j9*UP0RT) 

CALL GETTtDINPUT(IU9,DP0RT} 

CALL NAMGENCUOUT(JJ,UCOMNAMjDlNPUTa H 

C > TAG INPUT AS FROM AN UPSTREAM SOURCE 

CALL STRMQVtlH , 1 , 1»0INPUT C I) tS > 

N0C0N=1 

IF(HQDE,EQ,0>GQ TO 440 

C > SATISFY ALL OTHER INPUTS USING OUTPUTS OF SPECIFIED PORTS 

420 CALL PORTCNeDINPUTjNDINPUTTUOUT,NUDUT»DPORT,UPORT,UCOMNAH*NOCON* 

1 IH ) 

C > SATISFY UPSTREAM INPUTS 

CALL PORTCN « U INPUT , MU INPUT r DOUT ^NDO UT , UPORT , DPQRT , DCOM NAM , NQCON , 

I IHDl 
GO TO 560 
440 UPDRT-IH 
DP0RT=1H 

IF?IPHRS-EQ-I)GO TO 180 
CALL NXTPHaCOM, INDEX, PHRS) 

IPHRS=1 
GO TO 180 

500 IFtMODE.EQ^OiGO TO 560 

C > REGULAR CONNECTION ROUTINE 

C > SCAN DOWNSTREAM INPUTS 

DO 540 I^ltNDINPUT 

C > TEST IF INPUT IS SATISFIED 

IFtKQMSTR£DINPUT{I>®4,l,lH ,U.NE*0)G0 TO 540 

C > SCAN UPSTREAM OUTPUTS 

DO 520 J=1,NU0UT 

C > TEST FOR NAME MATCH 

IFCKOHSTRlDINPUT{n,l,3,UOUTtJ),l).EQ.OIGO TO 400 
520 CONTINUE 
540 CONTINUE 

560 IF{NOCDN,LE.O)WRITEIIWRITE,571)UCOMNAM,DCOMNAM 

571 F0RMAT(/5X,21H WARNING NO ,A4,* OUTPUTS MATCH UNSATISFIE 

ID +,A4,!^ INPUTS’!^ i 
C — -> STORE UPSTREAM INPUT LIST 

IFtNUINPUT.GT.OCALL WRITMSC7,UINPUT,NUINPUT,IUC0MP> 

IF( IDIAG.LE-70}GQ TO 600 
WRITEtIWRITEj80XHUINPUTCI),I=l,NUINPUT> 

801 FORMATt* INCOM-UINPUTS+Zf lX,6A10n 

WRITEaWRITE,803HUOUT{ I> ,I-ljNUOUTJ 
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803 F0RHAT(* INC0M-U0UT*/ClXf6AI0) > 

WRITE ( I WRITE t805H DINPUT ( I > > I=1»NDINPUT> 
805 F0RMAT{* IMCOM-DINPUT^/ { IX, 6A10I J 

WRITE C IWRITE ,807HDOUT ( I J , I-l ,MDOUT J 
807 FDRMATC* INCOM-DOUT^/tlX, 6A10 JJ 

C > TEST IF NEXT PHRASE HAS BEEN USED 

600 IFtIPHRS.EQ,0)CALL NXTPH £ ICGM , INDEX, PHRS ) 
RETURN 
END 
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CLINE 


CALL SEQUENCE; MODE 


SUBROUTINE LINE tMODS t SOURCE t ISDUR , TEXT? N t NTAPEJ 
purpose; TO CONTROL THE FLOW OF SOURCE TEXT AND GENERATE 

CONTINUES AS NEEDED TO STAY WITHIN COLUMNS 1-72 

- MODE-0 -> NEW LINE IS STARTED 8E&INING WITH 
HODE=l -> TEXT IS SPLIT TO FIT EXACTLY 7-72 

• NEXT CHARACTER FOR WRITING 

- NEW TEXT STRING 

• NO. OF CHARACTERS TO ADD 

- FILE TO WRITTEN TO 


ISOUR 
TEXT 
N 

NTAPE 

DIMENSION SOURCE (S) 

DATA X/lOH X 

> TEST FDR END OF LINE 

IFCISDUR+N.LE.73> GO TO 300 
IF(HODE.NE.O) GO TO 400 


/,BLNK/10H 


— -> NEW LINE REQUIRED 

> WRITE CURRENT LINE 


WRITECNTAPEjlOlJ SOURCE 
101 FORMAKSAXO) 

C > GENERATE CONTINUE SYMBOL 

SQURCE( ll=X 
DO 200 1=2,8 
200 SOURCE! n=8LNK 
IS0UR=7 

300 CALL STRMOVf TEXT,l,N,SOURCEtISOURJ 
ISOUR=ISGUR+N 
RETURN 

C — > HODE=l SPLIT TEXT BETWEEN CURI5ENT AND NEXT LINE 

400 N0=73-IS0UR 

C > COMPLETE CURRENT LINE 

CALL STRMOV! TEXT, 1, NO, SOURCE, ISOUR) 

WRITEfNT APE, lOlJ SOURCE 
SOURCE! 1)=10H X 
DO 420 1=2,8 
420 SOURCE! I)=10H 

C > NO, CHARACTERS LEFT IN TEXT 

L=N-NO 

C -— > NEXT CHARACTER IN TEXT TO MOVE 

NO=NO+X 

CALL STRMOVCTEXT,NOfiL, SOURCE, 7) 

ISOUR=L+7 

RETURN 

END 
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CLISTSC 

SUBROUTINE LISTSCCICPHAX,C[iPNTS,AINPUT?DUTPUT} 

C VERSION 2, revised: OCT 8 1976 

c purpose: provide a list of standard components and their 
c inputs? outputs? and tables 

C CALL SECUENCE: ICPMAX - NO- OF STANDARD COMPONENTS 

C CMPNTS - LIST OF STANDARD COMPONENT NAMES 

C AINPUT - WORK SPACE FOR INPUT NAMES 

C OUTPUT “ WORK SPACE FOR OUTPUT NAMES 

CQMMON/CIO/IREAD, IWRITE, IDIAG 

DIMENSION CMPNTS til »AINPUT i X 1 »OUTPUT 1 1 1 >TABLE f 10 } 

CALL READMSt78TPFNAME,l»6HPFNAME) 

WRITE tl WRITE , 101 ) PFNAME 

LOl FORMATUHl,lAXt+LIST OF STANDARD >5=TA10»*t= COMPONENTS^i* ) 

C > SCAN STD. COMPONENTS 

DO 560 1=1, ICPMAX 
WRITE(6,52UI?CMPNTStI) 

521 FORMAT t///15X,’i‘CQHP0NENT NO.*, 13,* NAME = *,A2// 
13X,* INPUTS*, BX,*0UTPUTS*,16X POTABLES*/ 

22 t* NAME PORT *>,* NAME INDP. VAR. MAX- DATA*! 

C > GET INPUT, OUTPUT, AND TABLE NAMES 

CALL COMDATtCMPNTSlI 1,AHINPT,NI, AINPUT) 

CALL CO HDAT t CMPNTS 1 1 } , 4H0UT P , NO, OUTPUT 1 
CALL C0MDATtCMPNTStI),4HTABS, NT, TABLE) 
MAX=MAX0[NI,N0,NT1 

C •> SCAN LONGEST LIST OF NAMES 

DO 560 J=1tMAX 

C > BLANK NAMES 

AIN=10H 

0UT=10H 

TAB=10H 

ID=10H 

IP=10H 

OP=IOH 

IV=10H 

ST=10H 

IFtJ.GT.NIJGO TO 530 
AIN=AINPUT(J) 

CALL GETT(AIN,9,IP) 

530 IFU.GT.NDIGO TO 535 
OUT=OUTPUTU) 

CALL GETTtOUT,9,aPJ 
CALL GETTt0UT,10,ST> 

535 IFt J .GT.NTIGO TO 540 
TAB=TABLEt J) 

C > GET TABLE DIMENSION 

CALL GETC0D{5,TAB,ID1 
IV=1H2 

IF! ID.GT.OIGD TO 540 

IV=1H1 

ID=IABS tID) 

540 WRITE (I WRITE, 541 IAIN, IP, OUT, OP, ST, TAB, IV, ID 

541 FORMATt2X,A6,Al,ax,A6,Al,lX,Al,7X,A6,5X,Al,9X.X3) 

560 CONTINUE 

WRITE(IWRITE,5631 
563 FORMAT tlHli 
RETURN 
END 
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CNArtARY 

SUBROUTINE NAMARYfCNAME ,NCHAR?N kNUNIT ) 

C VERSION 1.2 revised: AUG 22 1975 

C purpose: form a DATA STATEMENT THAT CONTAINS A GIVEN LIST OF NAMES 
C CALL sequence: CNAME - NAME OF THE ARRAY TO BE INITIALIZED 

C NCHAR “ NO. OF CHARACTERS IN ARRAY NAME 

C N - NO. OF NAMES TO BE PLACED IN DATA STATEMENT 

C NUNIT - UNIT CONTAINING LIST OF NAMES 

C DESIGNED BY: J.D» BURROUGHS MAY 1974 

DIMENSION SDURGE18S 

Q jest for empty set 

IF(N.LE.O) RETURN 
REWIND NUNIT 

C CALCULATE THE NO. OF DATA STATEMENT EXTENSIONS REQD. 

NEXT=tN“l)/l30-M 

C SCAN DATA STATEMENT EXTENSIONS 

DO 400 J=1,NEXT 

C EXTENSION COUNTER 

K=U-1 

C NO. OF CHARACTERS PER EXTENSION 

NiO=10’i^CN“K«‘130l 

C LIMIT NO. OF CHARACTERS PER DATA STATEMENT TO 1300 

IF{N10.GT.1300)N10=1300 

C CALC. FIRST AND LAST WORD IN LIST OF DATA STATEMENT 

ISTART=K=i=130+l 
IST0P=ISTART+N10/10”1 
Q — GENERATE DATA STATEMENT 
SOURCE( li=lOH DATA 

IS0UR=12 
DO 100 1=2,8 
100 SOURCE? I)=10H 

C > LOAD ARRAY NAME 

CALL LINE fOsSQURCE.iSOUR, CNAME, NCHAR, 9) 

C test if DATA STATEMENT EXTENSION IS REQUIRED 

IFIK.LE.O)GO TO 110 

C ENCODE DATA EXTENSION NO. 

ENCODE? 2,105,K)K 
105 FORMAT? 12) 

C add extension NO. TO DUMMY ARRAY NAME 

CALL LINE(0, SOURCE, iS0UR,K,2, 9) 

110 CALL LINEiO,SOURCE,lSDUR,IH/,l,9} 

ENCODE? 4, 121, N10)N10 
121 FORMAT? 14) 

C > load no. of CHARACTERS IN DATA STATEMENT 

CALL LINECO,SOURCE,ISDUR,N10,4,9) 

CALL LINE(0,SOURCE,ISOUR,1HH,1,9) 

C > SCAN NAMES 

DO 200 I=ISTART,ISTOP 
READ?NUNIT,125)ANAME 
125 F0RMAT(A7,3H ) 

C > LOAD NAMES INTO DATA STATEMENT 

CALL LINE{1,SQURCE,ISOUR,ANAME,10,9) 

200 CONTINUE 

CALL LINE? 1,SOURCE,ISOUR,1H/, 1*9) 

WRITE?9,20US0URCE 

201 FORMATCSAXO) 

400 CONTINUE 

RETURN 
END 
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CNAMGEN 

SUBROUTINE NAHGEN tSOURNH? COMNAM»QUANAM I 
purpose: GENERATE UNIQUE NAMES FDR ALL MODEL VARIABLES PARAMETERS 

CALL sequence: SOURNM - SOURCE NAME 

. COMNAM - COMPONENT NAME 
QUANAM “ QUANTITY NAME 

> TRANSFER SOURCE NAME TO QUANTITY NAME 

QUANAH=SOURNM 

C > ADD COMP. NAME TO COL- A TO 7 

CALL STRHDVf COMNAM, 1, A, QUANAM, A> 

C - — TEST COL- 9 FOR PORT NUMBER 

IF{KDMSTR{QUANAM,9,1,1H , 1 UEQ.O^RETURN 

C > test if col- 2 OR COL. 3 IS TO BE USED FOR PORT NO. 

1-3 

IFiKOMSTR {QUANAM, 2, 1,1H tU.EQ. 0)1-2 

C .> PLACE PORT NQ- IN COL. I 

CALL STRM0V{QUANAM,9,i, QUANAM, I) 

RETURN 

ENO 


52 


BCS 40262-2 


oni-* o o o o o oooonoooooonoo 


CNEWC OM 

SUBROUTINE NEWCDMiCOMNAM?CMpNTS»ICOMP,ALOC»CHPMDD»NOCOWP, 
lAJiNPUTp NINPUTt AQUTjNDUT » IDCOMP ) 

VERSION 2. REVISEOs JAf^ 12 1976 

PURPOSES INTRODUCE NEW COMPONENT INTO ECS MODEL 
CALL SEQUENCES COMNAH - COMPONENT NAME 

CMPNTS - LIST OF STD. COMP- NAMES 
ICOMP - LOCATION OF STD- COMP. NAME IN LIST 
ALOC - COMPONENT LOCATION NO. 

CMPMDD - LIST OF COMP. IN CURRENT MODEL 
NOCOMP - NO. OF COMP. IN CURRENT MODEL 
AINPUT “ STD. NAMES OF INPUTS FOR COMP. 

NINPUT - NO. OF INPUTS TO COMP. 

ADUT - STD. NAMES OF OUTPUTS FDR COMP. 

NOUT - NO. OF OUTPUTS FOR COMP. 

IDCOMP - COMP. NO. IN CURRENT MODEL 
DESIGNED BYt J .D .BURROUGHS DATES JULY 1974 

COMMON /CIO/IREAD»IWRITErIDIAG/CSEQ/NSEQtSEQA(l) 

DIMENSION CMPNTS £l)»CMPMODU>»AINPUT{l)gAOUT{l> 

> CONVERT LOCATiON NO. FROM HOLLORITH TO INTEGER 

CALL BCDRELCALOCtALQC) 

LDCNO=ALaC 

> GET SYMBOL NO. FOR COMPONENT AND PUT IN LOCATION 4 

CALL GETCQDf5»CHPNTSEIC0MP>sISYMB) 

CALL PUTC0Dt4sC0MNAM,ISYMB) 

TEST THAT 1 OR MORE COMP- EXIST IN MODEL 
IF{NDCOHP.LE.O)G0 TO 200 

> SCAN EXISTING COMPS. IN MODEL 

DO 100 I=1,N0CDMP 

— “> TEST THAT NEW COMP. NAME IS UNIQUE 

IF£KOMSTR{CHPHODCl}9is4rCOHNAMjU-EQ.OTGO TO 300 
00 CONTINUE 

~> NEW NAME IS UNIQUE 

> GET STD. INPUT LIST FOR COMP. 

200 CALL C0MDAT£C0MNAM>4HINPTjNINPUT,AINPUTS 

C > ADD LOC. NO. AND NO. OF INPUTS TO COMP. NAME 

CALL PUTC0D{3gC0MNAM,L0CN0) 

CALL PUTCODC 5, COHNAM, NINPUT > 

C ~> ADVANCE COMP. COUNT 

NOCOHP-NOCOMP+I 

C > ADD NEW NAME TO MODEL COMP. NAME LIST 

CMPMDD ( NOCOM P I -COMNAH 

C -> ADD COMP. NO. TO COMPONENT SEQUENCE LIST 

NSEQ=NSEQ+X 

CALL PUTCQDfNSEQgSEQAtrNOCOMP) 

IDCOMPsNOCDMP 

Q »_> get list of STD. OUTPUTS 

220 CALL COMDATt CMPNTS t ICOMP >?4H0UTPs NOUT? AOUT> 

RETURN 

C — -> test LOCATION NO. FOR COMP. THAT HAVE RECEIVED INPUTS BUT HA 

C BEEN DEFINED. 

300 CALL GETCOD(3>CMPHODU)?LN) 

IFCLN.LE.OIGO TO 400 
WRITEaWRlTE?30UCOWNAM 

301 F0RHATC/5X?29H *** WARNING *** COMPONENT ?A4?* HAS ALREADY BEEN 
IDEFINED+J 

GO TO 420 
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C — .> add location mq. to comf>. name 

A-00 CALL PUTCODf3,CMPMDDU) fLOCNOr 

C ADD SYMBOL NUMBER TO COMPONENT NAME 

CALL PUTCDD£4,CMPM0DCil tlSYMBl 

C > ADD COMP. NO. TO COMPONENT SEQUENCE LIST 

NSEQ=NSEQ+1 

GALL PUTCDDtNSEQ,SEQA,I> 

420 CQMNAM-CMpMODtn 

C > eex NO. OF INPUTS 

CALL GETCOD{5,COMNAM,NINPUT) 

C > GET INPUT LIST FROM FILE 7 

AINPUTUJ-3HZZZ 

IFfNINPUT.GT.OJCALL REAOMS{7tAINPUT»NINPUT»I > 

IDCOMP=l 

GO TO 220 

END 
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CORDER 

SUBROUTINE ORDERCNVjrlCDsAt IWl,IW2,IERROR, IBtIE} 

C VERSION 1. REVISED! AUG 4 1975 

C PURPOSE! GENERATE A SEQUENCE VECTOR THAT REORDERS VARIABLES 
C SO THAT CONNECTION MATRIX IS LOWER TRIANGULAR. 


c 

CALL SEQUENCE! 

NV 

- SYSTEM ORDER 

c 


ICO 

- SEQUENCE VECTOR 

c 


A 

- SYSTEM CONNECTION MATRIX 

c 


IWI 

- NTH ORDER VECTOR - PROCESS CODE 

c 


IW2 

“ NTH ORDER VECTOR - PROCESS SEQUENCE 

c 


lERROR - ERROR FLAG! 0 SYSTEM WAS REDUCED TO LOWER 

c 



TRIANGULAR FORM. 

c 



1 ~ SYSTEM CAN NOT BE REDUCED T 

c 



TRIANGULAR FORM 

c 


IB 

- FIRST WORD IN IW2 POINTING TO LOOP COMP* 

c 


IE 

- LAST WORD IN IW2 POINTING TO LOOP COMP- 

c 

DESIGNED BY! F 

PATH 

JULY 1975 


DIMENSION ICO(l), 

IWU1),IW2U},A(1) 


NCO=0 




lERRQR^G 



G 

SET ELEMENT 

COUNT 

m PROCESS SEQUENCE VECTOR TO ZERO 


NTW2=0 



c 

INITIALIZE 

PROCESS CODE FOR EACH ELEMENT TO -1 (NO PROCESS) 


DO 10 X=I,NV 
10 IWltI)=~l 

C FIND FIRST NON-PROCESSED ELEMENT 

15 DO 20 I=1»NV 

IFdWlCl) .LT.OSGO TO 30 
20 CONTINUE 

C IF ALL ELEMENTS PROCESSED » RETURN 

RETURN 

C PUT NON-PROCESSED ELEMENT INTO PROCESS SEQUENCE VECTOR AT BOTTOM 

30 NTW2=NTW2+1 

IW2(NTW2i==I 

C SET PROCESS CODE TO 0 (PARTIAL PROCESS) 

iwicn^o 

C CHECK FOR DEPENDANCE ON OTHER ELEMENTS 

JS=0 

40 JS=JS-H 

C IF ALL ELEMENT DEPENDANCIES CHECKED, PROCESS IS COMPLETE 

IF{JS.6T.NV>G0 TO 70 
K=IJBIT( A,I,JS,NVJ 

C IF NO DEPENDANCE (K-O) KEEP LOOKING 

IFtK-EQ*0)GO TO 40 

C IF DEPENDANT ON ELEM:ENT ALREADY PROCESSED «CDDE=11 KEEP LOOKING 

C IF DEPENDANT ON ELEMENT NOT PROCESSED tCODE=~li START PROCESSING 

C ON THAT ELEMENT- 

C IF DEPENDANT ON ELEMENT PARTIALLY PROCESSED (CODE=OJ SEQUENCING 

C IS IMPOSSIBLE. SET ERROR FLAG AND START ERROR REPORT- 

IFCIWK JSU50,60,40 
50 I“JS 

GO TO 30 
60 IERR0R=1 

C LOOK FOR JS IN IW2. THIS IS BEGINING OF DEPENDANT LOOP 

DO 65 K=1,NTW2 
IF(lW2(Ki.EQ.US)G0 TO 66 
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no no 


65 CONTINUE 

66 IB-K 

C SET END OF LOOP POINTER 

IE=NTW2 

C RETURN DUE TO ERROR 

RETURN 

C PROCESS FOR ELEMENT COMPLETE - UPDATE PROCESSED ELEMENT COUNT 

70 NCD“NCO+i 

C SET SEQUENCE VECTOR POSITION TO INDICATE ELEMENT 
IC0(NC01=I 

C SET PROCESS CODE FOR ELEMENT TO COMPLETE (CODE*li 

IWI(I}=1 

C DECREMENT PROCESS SEQUENCE POINTER 

NTH2=NTW2“1 

C IF ALL PROCESSED - RETURN 

IF(NCO.EQ*NV)RETURN 

IF NO ELEMENT LEFT IN PROCESS SEQUENCE VECTOR, GO LOOK FOR FIRST 
NON-PROCESSED ELEMENT. 

IFCNTW2.LE.0}G0 TO 15 

CONTINUE PROCESSING BOTTOM ELEMENT IN PROCESS SEQUENCE VECTOR 
WHERE IT WAS INTERRUPTED. 

JS-I 

I-IW2CNTW2) 

GO TO 40 
END 
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CPORTCN 

SUBRQUTIKE PORTCNtAIMPUT,NIMPUTsOyTPUTtNOUT,IPORTfOPaRT,DUTNAMs 
1 NQCQNf STREAM) 

PURPOSE t CONNECT ALL MATCHING PHYSICAL QUANTITIES AT SPECIFIED 
PORTS ON TWO COMPONENTS. 

CALL sequence; a input “ INPUT QUANTITY NAME LIST 

NINPUT - NO. OF INPUT QUANTITIES 
OUTPUT - OUTPUT QUANTITY NAME LIST 
NDUT - NO. OF OUTPUT QUANTITIES 
I PORT “ INPUT PORT NO. 

□PORT - OUTPUT PORT NO. 

□UTNAM - OUTPUT COMP. NAME 
NOCON - NO CONNECTION FLAG 

STREAM - SOURCE INDICATOR. BLANK = UPSTREAM SOURCE 
D = DOWNSTREAM SOURCE 
DIMENSION AINPUT(l>,OUTPUT{i) 

C --»> SCAN INPUT LIST 

DO 200 I=lsNINPUT 

C — > TES^ IF INPUT IS SATISFIED 

IFiKOMSTRiAlNPUTaUAfljlH ,U.NE.O)GO TO 200 

C > BYPASS PORT TEST IF INPUT IS UNIVERSAL PORT 

lF{KQMSTR(AINPUT(5),9fljlH ,U.EQ.O)GO TO 100 

C *> BYPASS TEST IF SPECIFIED PORT IS UNIVERSAL PORT 

IFaPGRT.EQ.lH )GQ TO 100 

C > COMPARE PORTS 

IF{KOMSTR{AINPUTiI) »9Tl,IPaRT7l>.NE.O)GO TO 200 

C > SCAN OUTPUTS 

100 DO 120 J=1»N0UT 

C “> TEST FOR PHYSICAL QUANTITY HATCH 

IF£K0HSTR(AINPUTiI),l,3,DUTPUT{J),n.NE.0)G0 TO 120 
C » — > BYPASS PORT TEST IF SPECIFIED PORT IS UNIVERSAL PORT 

IFIOPDRT.EQ.IH IGQ TO 140 

C > BYPASS PORT TEST IF OUTPUT IS UNIVERSAL PORT 

IFtKOMSTR£DUTPUT« J1,9,1,1H ♦U.EQ.OGO TO 140 

C > TEST FOR PORT MATCH 

IF(KQMSTR{0UTPUT{J)s9,lt0P0RT,l).EQ.0)G0 TO 140 
120 CONTINUE 
GO TO 200 

C > SATISFY INPUT 

140 CALL NAMGEN{OUTPUTU)fOUTNAH9 AINPUTlin 

C > PLACE SOURCE INDICATOR IN NAME 

CALL STRMOVCSTREAMjlsltAINPUTCDtS) 

NQCDN=1 

200 CONTINUE 
RETURN 
END 
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SUBROUTINE SCHEMAtCHPMOD,NOCOMP»INPUTS,NAMES) 

C VERSION 2» revised: SEPT 10 1975 

C PURPOSE: PRODUCE A SCHEMATIC DIAGRAM ON THE LINEPRINTER 

C OF THE ECS MODEL 

C CALL SEQUENCE: CMPHOD - LIST OF COMPONENTS IN MODEL 

C NOCOMP - NO. OF COMP. IN MODEL 

C INPUTS - WORK ARRAY FOR INPUT NAMES 

C NAMES “ WORK ARRAY FOR LABEL NAMES 

C DESIGNED BY: J.O* BURROUGHS JUNE 1974 

COMMON /GlO/IREADtlWRlTEf IDIAG/CTlTLE/TITLEt7> 
DIMENSION PAGE{13,56 J *CMPMOD(l)sINPUtS(l J ,NAMES{ 1) 
MAXPAG=:0 
NPAGE=0 

Q > blank page and LOAD LOCATION NUMBERS 

100 LOC-NPAGE 

C > LOCATION NO. LINE COUNTER 

LGCL=4 

C — > SCAN ALL LINES ON PAGE 

DO 160 1=1,56 

C — ~> BLANK ENTIRE LINE 

DO 120 J=l,13 
120 PAGECJ,I>=10H 

Q IP i_i|^p CONTAINS LOCATION NUMBERS. 

IFCI.LT.LOCDGO TO 160 

C ™> INCREMENT LOCATION NO. LINE COUNTER 

L0CL=LDCL+7 
L0CCQL=™8 

C > SCAN CDLS. AND LOAD LOCATION NOS. 

DO 140 J=l,10 

C > INCREMENT LOCATION NO- 

LOC=LOC+1 
LOCCOL=LOCCQL+13 
ENCODE ( 4, 139 , LOCNOILOC 

139 FORMATC I4J 

CALL STRM0VtL0CN0,l,4,PAGEU, DyLOCCOL) 

140 CONTINUE 
160 CONTINUE 

C > PLACE COMPONENT SYMBOLS ON PAGE 

Q > XEST that more than 0 COMP. EXIST IN MODEL 

IFtNDCOMP.LE.O)GO TO 602 
C — SCAN COMPS. IN MODEL 

DO 300 1=1, NOCOMP 
COMNAM=CMPMOD( I) 

C SKIP FORTRAN COMPONENTS 

IFCKOMSTR{COMNAMafA-,4HFORT,l).EQ.O)GO TO 300 

C GET LOCATION NO. FROM COMP. NAME 

CALL GETC0D(3,C0MNAMi-L0C} 

C »> DETERMINE PAGE NO. 

LOG PAG= { LOC/iOO )*1Q0 

C — > DETERMINE MAX. NO. OF PAGES REQ D. 

MAXP AG=H AXOt MAXPAG, LOCPAG ) 

C — ”> DETERMINE MAX. NO. OF PAGES REQ D. 

MAXPAG=MAXO CMAXPAG, LOCPAG ) 

C > TEST IF COMPONENT IS ON CURRENT PAGE 

IF(LOCPAG.NE.NPAGE)GO TO 300 
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C CONVERT GENERAL RAGE LOCATION TO LOCAL PAGE LOCATION 

LOCPAG=LQC-LOCPAG 

c — > test to assure ldc no* is on page 

IF(LOCPAG,LT.i-OR.LOCPAG.GT.S0>GD TO 260 

C “““> ADD SYMBOL TO CURRENT PAGE FOR COMPONENT 

call GETCQDt4,C0MNAM,ISYMB) 

IF?IDlAG.EQ.22)WRlTEtlVfRITE»251iCOMNAMfCOHNAM,XSYHB 
251 FORMATl=i' SCHEMA *,A10, 1X^020, 110} 

CALL SYMBOLCPAGEsCOHNAMjrSYMBsLQCPAG) 

Q P0p.f^ TABLE OF COMPONENT NAMES tON ONLY FIRST PASS) 

GO TO 300 

260 WRITEd WRITE, 261) LDCjCOMNAM 

261 F0RHATC/5X,3IH WARNING LOCATION NO. ,14? 

1 * FOR COMPONENT ^,A4p= 4= HAS LAST TWO DIGITS OUTSIDE THE ALLOWABL 
2E RANGE OF 1 TO 80,»i^/18X, 

3^N0 SYMBOL WILL BE PLACED IN SCHEMATIC FOR THIS CQMPONENTr^) 
LDC--100 

300 continue 

C — > ADD CONNECTING LINES AND NAMES TO SCHEMATIC 

C .> SCAN MODEL COMPONENTS 

400 DO 500 I=l?NOCOMP 

Q BYPASS DIRECT FORTRAN INPUT COMPONENTS 

IFtK0MSTRCCMPM0D(I>,l,4,4HF0RTa) .EQ.O)GQ TO 500 

C > GET LOCATION NO. 

CALL GETCODC3,CMPMODd),LOC) 

C > DETERMINE PAGE NO. 

LOCPAG= ( LOC/lOO ) ^100 

C > CONVERT LOC TO LOCAL PAGE LOCATION 

LOC=LaC-LOCPAG 

C — -> TEST TO ASSURE LOC NO. IS ON PAGE 

IFtLQC.LT.l.QR.L0C.GT.80)LDCPAG==-l 
C SKIP INPUTS TO QUANTITIES ON OTHER PAGES 

IF{LOCPAG.NE.NPAGE)GO TO 500 

C > ^ET NO. OF INPUTS TO COMP. 

CALL GETC0D{5jCMPMDQ(I),NINPUTJ 

G '> BYPASS COMP. WITH NO INPUTS 

IF{NINPUT.LE.0)G0 TO 500 
C — -> GET INPUTS LIST 

CALL READMSi?, INPUTS, NINPUT, I) 

C — ^-> INITIALIZE NO. INPUTS COUNTER CURRENT INPUT COMP. NAME 

420 N0IN=0 
MQRE=0 

INC0M=7H***=J=**+ 

IF( lDlAG.EQ-30) WRITE aWRITE, 423>CMPM0DU ), (INPUTS (J),J=1,NINPUT) 
423 F0RMAT(=4' SCHEMA-INPUTS *, AlO/lOt IX, AlOH 
C — > SCAN INPUTS 

DO 480 J=1,NINPUT 

C > TEST IF INPUT IS FROM CURRENT COMP. I.E. PARAMETER 

IF(KDMSTR(INPUTS(J),4,1,1H ,1)-EQ-0)GO TO 480 

C > IS THIS A NEW INPUT SOURCE 

IF(K0HSTRlINC0M,4,4,INPUTStJ) ,4).EQeO)GO TO 440 

C BYPASS NAME LOAD IF 2ND COMPONENT APPEARS 

IFtMQRE.NE.OiGO TO 4e»0 

C > SAVE NEW SOURCE NAME 

INCOM=INPUTSf J) 

MQRE=1 
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c — ™> advance input count 

440 N0IN=N0IN+1 

NAMES {NOIN)=^INPUTSCJ) 

INPUTSC Ji=XOH 
GO TO 480 
460 M0RE=2 
480 CONTINUE 

C > IS THERE A CURRENT INPUT COMPONENT 

IF{N0IN*LE*0^G0 TO 500 

CAUL CONNGTtPAGEfNPAGE, LOG, NAMES pNOINfCMPMOD, NOCOMP) 

C DO MORE COMPONENTS PROVIDE INPUTS 

XF(H0RE,£Q»2160 TO 420 
500 CONTINUE 
C PRINT PAGE 

602 NAME-NPAGE/100 

WRITE{rWRITE,605) TITLE, NAME, PAGE 
605 FORMATt XHX , 2PX,7A10924X,=«^PAGE^,I3/r2X, X3A10) i 

e ^ — > test for last page 

IF(NPAGE,GE.MAXPA6)RETURN 

NPAG£=:NPAGE+XOO 

GO TO XOO 

END 
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CSYMBOL 

SUBROUTINE SYMBOL (PAGE, COMNAMfISVMB»LOC) 

VERSION 1*2 revised: OCT 17 1975 

purpose: add component symbols and names to ECS MODEL SCHEMATIC 


CALL SEQUENCE: PAGE 


CQMNAM 
ISYMB 
LOG 

DESIGNED BY: J»D«BURROUGHS 

COMMON/CIO/iREAD, IWRITE,IDIAG 
DIMENSION PAGEU3956> 

— > LOCATION LINE NO. 

L0CLIN=7*( (LOC-U/lOJ+3 


13X56 ARRAY CONTAINING HOLLERITH 
REPRESENTATION OF A PAGE 
NAME OF COMPONENT TO BE ADDED TO PAGE 
SYMBOL TYPE NO. 

LOCATION OF SYMBOL ON PAGE 

JUNE 1974 


C > LOCATION COLUMN NO. 

LQCCOL=(MDD(LOC-1,101+X}*13-10 

C > ADD COMPONENT NAME TO PAGE 

CALL STRMQVCCOMNAM, 1,4, PAGE {1,L0CLIN),L0CC0L+3J 
I F (I DIAG-EQ,22)VfRITECIWRITE,22)C0MNAH,IS YMB , LOC 
22 FORMAT(* SYMBOL *,A10,2I10) 

C > TEST FOR SYMBOL TYPE 

C 

C SYMBOL NUMBERS LESS THAN 64 SHOULD NOT BE USED DUE TO 

C CSQRT REPLACING OOB WITH 55B WHEN CALLED BY FILQAD. 

C 


IFdSYMB.EQ.lOOlGO TO 200 
IF(ISYMB.EQ.200iGO TO 400 
IFtISYMB.EQ.300> GO TO 300 
IF(ISYMB.EQ.400)G0 TO 500 

C > DEFAULT SYMBOL - SQUARE 

L0CLIN=LQCLIN-2 

Q > jQp AMD BOTTOM LINES 

CALL STRMOVS 1,10, PAGE ( 1 ,LOCLIN) , LOCCOU 

CALL STRMOV , 1, 10, PAGE { 1 ,L0CLIN+5 ) , LOCCDL) 

C > SIDES 


DO 100 1=1,4 

GALL PUTT ( PAGE 1 1 , LOCLIN+IJ , LOCCQL , IH* ) 

CALL PUTT (PAGE 1 1 , LOCLIN+I ) ,L0CC0L-*-9 
100 CONTINUE 
RETURN 

C > COMPRESSOR SYMBOL 

200 L=LOCCQL 
K=2 

lCOL=L-!-i 

205 LDCLIN=L0CLIN-5 
DO 220 1=1,10 
LOCLIN-LOCLIN+1 

C TEST TO PREVENT TOP OF SYMBOL FROM GOING OFF TOP OF PAGE 

IF(L0CLIN.LT.1)GD TO 208 

C > TEST TO PREVENT BOTTOM OF SYMBOL FROM GOING OFF PAGE 

IF(L0CLIN.GT.56IRETURN 

C > STRAIGHT EDGE OF SYMBOL 

CALL STRMOV ( IH* , 1 # 1 , P AGE 1 1 , LDCLI N ) , L > 

C > SLOPING EDGE OF SYMBOL 

CALL STRMOV(lH=S',l,l,PAGECl,LOCLIN),ICOLi 
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G =t= — > test to reverse slope of right edge 

208 IFU^EQ.SiGO TO 215 
ICOL=IGOL+K 
GO TO 220 
215 K--K 

220 CONTINUE 
RETURN 

G > TURBINE SYMBOL 

300 L=LQCCDL^9 
K ="2 

lCOL-L-1 
GO TO 205 

C > CIRCLE SYMBOL 

400 LQCLIN-LOCLIN-2 

CALL STRMOVtlOH , 1, 10,PAGE {l,LaCLIN} , LOCCOLi 

CALL STRMOVUOH , 1, 10,PAGE{l,LOCLIN+5JfrLDCCOL) 

K-1 

L=L0CC0L+1 

ICOL-L+7 

G .> add sides TO SYMBOL 

DO 420 1=1,4 
LOCLIN=LOCLIN-^1 

G — > left edge of SYMBOL 

CALL STRMOV t IH*, 1 , 1 ,P AGE ( 1 , LOCLIN ) tU 

C > RIGHT EDGE OF SYMBOL 

CALL STRMOV ( 1H=^, 1, 1, PAGE ( 1 , LOCLIN ) , ICOLJ 

C > REVERSE SLOPE OF EDGES 

IFiI.EQ,2)GQ TO 415 
L=L-K 

IC0L=ICQL+K 
GO TD 420 
415 R=“K 
420 CONTINUE 
RETURN 

G OPTIMAL CONTROLLER SYMBOL 

500 L0CLIN=L0CLIN-2 

C > TOP AND BOTTOM LINES 

CALL STRMOVUOH □DOaODOD , 1,10,PAGE { 1 ,LQCLIN^ , LOCCOU 
CALL STRMOVtlOH OQOOQOOO , 1, 10,PAGE t 1, LOCLIN+5 I , LOCCOL 1 

C > SIDES 

DO 520 1=1,4 

CALL PUTTtPAGEtl?LaCLlN+I} ,LDCCOL,1HO) 

CALL PUTTtPAGEll,L0CLIN'U),LQCC0L+9,XH0> 

520 CONTINUE 
RETURN 
END 
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CTABCAL 

SUBROUTINE TABCAL 

C PURPOSE t SENERATE TABLE INPUT REQUIREMENTS LIST ON FILE 12 
CQHMON/CTAB/NQTAB,tABNAMU ) 

WRXTEtl2»lli 

IX F0RMATU6X,*TABLES REQUIRED’S:// 

l2X?’i'C0MPaNENT TABLE NO, INDEP. MAX, DATA*/ 
2AXt*NAME*,7XT^NAME'J=*5X,=i'VARIABLES ALLOWED^i^} 

COMPS=XOH 

COMP=CQHPS 

C — -> SCAN TABLES* 

DO 100 1=1, NOTAB 

C > get TABLE NAME 

CALL STRHOVCTABNAMC II ,1,7, ANAME.l > 

c — > get maximum dimension for table 

CALL GETC0D{5,TABNAMtI) ,N) 

N1=IABS(N> 

Q — > get specific component name 

CALL STRMOVtANAHE,4»4,COMP,l ) 
lFtCOMP.£Q*CQMPS) GO TO 60 
WRITE{12,51> 

51 FORMATCIH ) 

COMPS=COMP 
60 Nl=Nl-3 

C > TEST FOR SINGLE OR DOUBLE INDEP. VARIABLE TABLE 

IFCN.GT.Ol GO TO 70 
N=1 

60 TO 80 
70 N=2 

80 WRITEU2,81)C0MP,ANAME,N,N1 

81 F0RMAT(4X,AA,5X,A7,6X,ri9XQX,I4J 

100 CONTINUE 

RETURN 

END 
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GTABDAT 

SUBROUTINE TABDAT 

C VERSION 3. REVISED MAY 4 1976 

C PURPQSEt GENERATE DATA STATEMENTS FOR MODEL TABLE DATA INPUT CONTROL 
C DESIGNED BY; BURROUGHS DATES MARCH 1975 

C0MMQN/CTAB/N0TAB,TABNAM 1 1 J 


DIMENSION SQURCEtSl 

C =-=:===== SET NUMBER OF TABLES IN MODEL 
WRITE{9>91)N0TAB 

91 F0RMAT(6X,+DATA NOT AB/’f', 13 
IFtWOTAB.LE.OJRETURN 

C — > LOAD TABLE NAME DATA 

SOURCEt 1}=10H DATA 

SDURCEC2 J=10H TABNAM/ 

ISOUR-19 
DO 100 1=3,8 


100 SOURCEII)=10H 

C ” — > CALC. NO- OF CHARACTERS IN TABLE NAME LIST 

N10=10*NOTAB 
ENCOOE(4,101,NlOiN10 

101 FORMAT { 13, IHH) 

C > ADD NO. CF CHARACTERS TO DATA STATEMENT LINE 

CALL LINEt0,S0URCE,IS0UR,N10,4,9) 

ANAME=10H 

C > SCAN TABLES 

DO 200 1=1, NOTAB 

CALL STRHDVtTABNAMtI),l,7,ANAME,l ) 

C > ADD TABLE NAME TO LINE 

CALL LI NE a , SOURCE, 1 SOUR, ANAME, 10,91 

200 CONTINUE 

CALL LINE (1, SOURCE, iSOUR,lH/, 1,91 
WRITE(9,201 ISOURCE 

201 F0RMAT18A10S 

C > LOAD TABLE DIMENSION DATA 

SOURCE! 1)=10H DATA 

S0URCE(21=10H MAXDIM/ 

ISDUR=19 
DO 220 1=3,8 
220 SOURCE! I 1=10H 

C > SCAN TABLES 

DO 240 1=1, NOTAB 

C > GET MAX. TABLE DIMENSION 

CALL GETC0Dt5,TABNAWm,Nl 
N=IABS(N) 

C > CONVERT TO DISPLAY CODE 

ENC0DE!5v23l,N)N 
231 F0RMAT(I4,1H,1 

IFil.GE.NOTABlCALL STRHOV! IH/,1,1,N,5) 

C > ADD MAX. DIMENSION TO LINE 

CALL LINE(0,SDURCE,IS0UR,N,5,9> 

240 CONTINUE 

WRITE!9,201 ISOURCE 
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C > load table location data 

SOURCE Ut=lOH DATA 

SOURCE{21=10H LQCTAB/ 

ISDUR=19 
DO 300 1=3,8 
300 SOURCE(I1=10H 
LQC=1 

C > SCAN TABLES 

DO 320 I=l,NOTAB 

C > CONVERT TO DISPLAY CODE 

ENCODED 5, 231, N) LOG 

I FI I. GE -NOTAB) CALL STRMOVtlH/, 1,1 ,N,5 ) 

C > ADD TABLE LOCATION NO. TO LINE 

CALL LINE(0,S0URCE,IS0UR,N,5,9> 

C > GET MAX- DIMENSION OF TABLE 

CALL GETCQDt5,TABNAM(Il,N) 

C — > CALC- THE NEXT TABLE STARTING LOCATION 

LOC=LQC+IABStN) 

320 CONTINUE 

WRITE{9,20US0URCE 

RETURN 

END 
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CTABGEIM 

SUBROUTINE TABGEN 

PURPOSES GENERATE THE TABLE COMMON FOR ECS MODEL 
CALL SEQUENCES NTAB - TOTAL NO. OF TABLES REQ D BY MODEL 
METHOD: THE NAMES OF THE TABLES AND THEIR DIMENSIONS ARE STORED 

IN TABNAM. THE NAME IS STORED IN THE FIRST 7 CHARACTERS 
OF EACH WORD AND THE DIMENSION IS STORED IN THE LAST 2 
CHARACTERS VIA THE ROUTINE PUTCOD* 
COMMDN/CTAB/NDTABrTABNAMtlJ 
DIMENSION SOURCE{8)*'SOTAB(H} 

IF(NOTAB»LE.OmETURN 
WRITE{9,10) 

10 FORMAT(=i'C > TABLES*) 

SOURCEtl )=10H COMM 

SOURCES 2 )=TOHON/CTABLE/ 

DO 100 I=3»8 
100 SQURC£{I)=10H 
ISQUR=22 

C SCAN ALL TABLES IN THE MODEL 

DO 200 Is=l,NDTAB 

C > get TABLE DIMENSION 

CALL GETCQDt5,TABNAHCI)>N) 

N=IABStN} 

c — get table name 

CALL STRMOVCTABNAMEI) ,l»7,S0TAB.l) 

C -> CONVERT DIMENSION TO BCD 

ENC0DE{6,105»N)N 
105 FORMATUHE ,I3s2H) ,) 

C REMOVE COMMA IF LAST TABLE 

1F{I.GE.N0TAB)CALL STRMOVElH ,i,ltN»6) 

CALL STRM0VEN,1,6,SDTAB,8) 

C ADD TABLE NAME TO SOURCE LINE 

CALL LINEE 0, SOURCE, IS0UR,SQTAB,13t9) 

200 CONTINUE 
WRITE(9,201)S0URCE 

201 FORMATE SAlO) 

RETURN 

END 
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CVLINE 

SUBROUTINE VLINE ( PAGE , ICOL, IN » IR J 
PURPOSE: PAGE “ 13X56 ARRAY CONTAINING HQLLORITH 

REPRESNETATXDN OE A PAGE 
ICOL COLUMN NO. OF LINE 
IN “ LINE NO. OF INPUT COMPONENT 
IR - LINE NO. OF RECEIVING COMPONENT 
DIMENSION PAGE f 13, 56) 

C -*-«> IS INPUT ABOVE OR BELOW 

IFilN.GS.IRiGO to 100 

C > INPUT IS ABOVE 

P0INT=10HV 
I1=IN 
I2=IR 
GO TO 200 

C > INPUT IS BELOW 

100 POIWT=10HA 
I1=IR 
12-IN 

C > PLACE POINT ON RECEIVING END OF LINE 

200 CALL PUTT(PAGE(1,IR),IC0L9P0INT1. 

C > ADD NO. OF SYMBOLS REQ D- TO SPAN LINES 

DO 300 I-II 9 IZ 

C TEST TO PREVENT OVERWRITING POINTS 

IF(KOMSTR(PAGEU,I>,ICQLTlilHA,l).EQ-0)GQ TO 300 
IF{KOMSTR(PAGE{l,neICOL,l,lHV,XKEQ.O}GQ TO 300 
CALL PUTTiPAGEa,n»ICOL,lHIi 
300 CONTINUE 
RETURN 
END 
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3.0 ANALYSIS PR0GR/y4 DESCRIPTION 


3.1 INTRODUCTION 

The Analysis program accept? program coirniands which describe analyses to be 
performed on the given system model. Each analysis is then performed on the 
•nonlinear system model that was created by the Model Generation program. Each 
analysis resides in an overlay which is brought into core to perform the 
requested analysis. The system model is placed in the root of the overlay 
structure since it is accessed by all of the analyses. The core requirements 
of the program have thereby been held constant as numerous analyses have been 
added to the program's capabilities. However, program core requirements do 
vary as a function of model size, growing as the square of the number of states 
in the model. 

3.2 PROGRAM STRUCTURE 

Figure 3. 2^1 contains a macro flow diagram of the SIMWEST Analysis program. 
This flow diagram shows the principle tasks of the program. For each task, a 
statement number of the main, (NONSIM), program is given along with the name of 
the principle program that accomplishes that task. 


The sequence of performing the various tasks depends on the analysis and data 
requests. As each analysis is performed. Its outputs are generated on the 
linepr inter. 

3.2.1 Overlay Structure 


Figure 3.2-2 contains a diagram of the overlay structure of the Analysis 
program. The main program, (NONSIM), the system model, (EQMO, DATAIN, MODEL 
and standard component subroutines), and other frequently used routines reside 
in the main overlay, (0,0). Table 3,2-1 provides a brief description of each 
overlay. 
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FIGURE 3.2-2 SIMWEST ANALYSIS PROGRAM - OVERUY STRUCTURE 




TABLE 3*2-1 OVERLAY DESCRIPTIONS 


Overlay 

Level 

Main Program 
Name 

Hescription 

(0,0) 

NONSIM 

Contains system model and frequently used 
routines such as eigenvalue-calculation 
routine, E6VL3. 

(1.0) 

INIT 

Program initialization 

(2.0) 

INTERP 

Interprets data input and analysis request 
commands 

(3,0) 

GFBTCH 

Algebraic function scan 

(4,0) 

SIBTCH 

Nonlinear simulation 

(4,1) 

NRKV 

Runge-Kutta integration 

(4,^) 

DIFSUB 

Gear integration 

(5,0) 

LABTC 

Linear Analysis and Eigenvalue Sensitivity 

(6,0) 

SMBTCH 

Stability Margin 

(7.0) 

TFBTCH 

Transfer Function 

(10,0) 

SSBTC 

Steady State Calculation 

(11,0) 

RLBTCH 

Root Locus Calculation 
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The INTERP program is brought into core to interpret each input data card. 
Those program commands that involve only data storage or modification are 
performed by IRTERP or one of the other routines in the (2,0) overlay. When an 
analysis request command is encountered, INTERP returns control to the main 
program which calls in the appropriate analysis overlay. 

3.2.2 Command Interpretation 

Figure 3.2-3 contains a macro flow diagram of the Analysis program cormand 
interpretation process. Each input data card is read and printed to provide a 
record of the progress through the analysis requests. Phrases are identified 
on each card by the routine NXTPH. When a blank phrase is encountered, a new 
card is read. Each phrase is tested against the three types: ccmnand phrases, 
program names, and program values. If one of these types is recognized, the 
proper action is taken. If the phrase is not one of these types, a test is made 
for an outstanding task. An outstanding task consists of such multiphrase 
tasks as defining state names, inputting parameter values, specifying initial 
conditions, etc. If there is no outstanding task, the warning message ''CAN'T 
INTERPRET xxxxx" is printed and the program goes on to the next phrase. 

3.2.3 Temporary Files 

Two temporary files TAPE25 and TAPE30 are used by the Analysis program. TAPE25 
serves as a temporary buffer for steady-state and simulation plot data. The 
plot data for each report interval is stored on TAPE25 until all report inter- 
vals for the steady-state analyses or the simulation analysis have been comple- 
ted. Upon completion of the steady-state or simulation analysis, information 
describing the number of plots, report intervals, and plot scales are placed on 
TAPE30 and the plot data itself is transferred from TAPE25 to TAPE30. For 
other analyses such as root locus or transfer functions, the plot data is 
placed directly on TAPE30 upon the completion of the analysis. 

Upon completion of all analyses for a particular run, TAPE 0 is processed by a 
separate program (NSHPPT) to generate lineprinter plots. 
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3.3 ANALYSIS PROGRAM SOURCE LISTINGS 


Compilation listings for ths simulation program follows. Some subroutines 
such as NXTPH and LCMPH are used in several of the programs and will be found in 
the source listings for the FILOAD program (Section 4„3). There are five 
subroutines which are onljy called by the model EQMO or the library components. 
These are listed after the simulation program source. The names of the simula- 
tion routines, in order of appearance, are: 


BLOCK DATA 

PLINIT 

CODGEN 

PLOTAB 

CQDLOD 

PREC2 

DIFSUB 

QNWT2 

DIFSU2 

RKINIT 

DISPLA 

RLBTCH 

OTTIM 

ROTCAL 

EGVL3 

SCALE 

EQVCL 

SETIN 

EVAL2 

SHELLX 

EVCHB 

SIBTCH 

EVORDR 

SLVEQ 

FSHELL 

SM8TCH 

GANMAR 

SSBTC 

GFBTCH 

SSBTCH 

IN IT 

STABMX 

INPUTS 

STEPl 

INTEP.P 

TABIN 

LABTC 

TFEVAL 

LABTCH 

TFBTCH 

LPRINT 

THSB2 

LUEQS 

TITLE 

NAMES 

TRNFCN 

NATFRQ 

VALUES 

NONSIM 

VARMOD 

NRKV 

VAROUT 

NRKVS 

XFR 
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C BLOCK DA 

BLOCK data 

C VEKSIQN revised; APRIL 30 1976 

CDMMOM /CSlHUL/IPRlNtlPRATE,IQUTfMPTST?4PTMAXsIf80HAX,TINC,TMAX 
1 , INDEX, IPLDT»IDEMT{4) 

COKMDN/C PRDN/PRONAH ( 8 } /CPROV/P VA LUE C 27 J /C SMP AR/SHP AR { 1 0 1 » IC IN D [ 2 3 
COMM Gi«/CCOMM/iCOH t S3 , I PHRS r INDEXX 
COHMC»j /CSCALE/SCALE{5»4ff63 »?4VARS5 > 2»63 ,NPLTS C A J 
COMM ON/CIQ/IREAD, I WRITE, IDIA& 

CDMMON/CPRINT/PRTNAMC 10) ,LPRTC 10 ) 

CDHM GN/COVR LY /INST ,LOKSS ,LOKSiM, CPUS EC 

REAL IDENT,NVAR,PRONAH,SMPAR 

DATA lPRIN,IPRATfc,IQUT,TiaiC,TMAX/0,I,l,«i.,l-/ 

DATA IDENT/A*10HTIME / 

DATA INDEX, iPLDT/Ojl/jINDEXX/O/ 

DATA PRDNAH/S*10H /,SMPAR/8=t^lOH / 

DATA P VALU t/“li. , I • ^ ~i a,0a,li!Bs0iafJ.t>,X»,3a,«!L,Iat*l,I00a9~'Iv,lk,3», 

XSOajOajXajSio J ~1 OsyOa^Qn, XO « ,0a ,0a, O b^ 

DATA «PTMAX/i/, INDMAX/505/ 

DATA NPLTS/3*1,3*0/,NVAR/30^1QH /,SCALE/120*0-/ 

DATA lCIND/2*0/ 

DATA IREA0,IWRITE,IDIA&/5,fc,0/ 

DATA PRTNAM/IO^XOH /,LPRT/i0*0/ 

DATA INSI , LOKSS , LOKSIM/3=5^i/ , CPUScC/0 . / 

ES^D 
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noon no o n o o o o n 


CCDDGEN 

SUaRDUTINE CODGEN(IDENT,ICrICQDE It RETURNS CRIJ 
PURPOSES GENERATE INTEGER IDENTIFICATION CODES GIVEN ALPHANUMERIC 
GALL SEQUENCES IDENT - ALPHANUHERIC IDENTIFIER 

IC - INITIAL CDND5TICN INDICATOR 
ICODE - INTEGER CODE NUMBER 

ai =• RETURN TAKEN WHEN IDENTIFIER CAN*T BE FOUND 
CQDfe: SCHEMES THE SEVENTH COLUKM IS USED TO DESIGS^ATE WHICH GROUP 
THE QUANTITY BELONGS. THE FOLLOWING CODE IS USEOS 


STATE VARIABLES = 0 
STATL DERIVATIVES ' i 
STATE 1. 0-4=5 2 
VARIABLES = 3 
PARAMETERS = 4 


ICODE = 0 IS USED FOR TIME 

COMM GN/CNAM EX/NAKEX 1 1 ) /CNAKER/NAHER ( 1 1 /CNAM EVV^AME V ( 1 5/CNAM £P/ 
1 NANEPCL) 

COHMl^/CGaDER/NDXtNDVtNDP 

REAL IDENTxNAMEXtNAMERtNAMEVtNAHEPtNTlHEt BLANK 
DATA NTIME/iOHTIHE /t BLANK/ lOH / 

IFUDENT-EQ-SLANKIGD TO 260 
G TEST FOR TIME CODE 

IFUOENT-NE-NTIHE) GO TO 80 

1CDDE=0 

RETURN 

C SEARCH STATE NAMELIST 

SO CALL LCHPHtIDENT,NAHEXtNOX?lsiCQDEl 

IF(lCGDE-fcQ-OI GU TO 90 
IFCIC-EQ-O) RETURN 
GO TO 255 

C SEARCH VARIABLES NAMELIST 

90 CALL LCHPHt lOENTtNAMEVsNOVjltlCQDE) 

IF(ICODE-NE.O) GO TO 225 
C SEARCH KATES NAMELIST 

CALL LCMPHJ iD£NTsNAMER,NOX»l»ICGDEJ 
IFf ICODE. NE.Q) GO TO 235 
C SEARCH PARAMETER NAMELIST 


CALL LCHPHC IDENTrNAMEP It ICODE ) 

IFCICODE.NE.OJ GO TO 24^ 


C IDENTIFIER CAN4=T BE RECQ&NI2ED- 
ICODt=-.“l 
RETURN R1 

225 ICODE=ICODE+3000000 
RETURN 

235 ICaDE=ICODE-t-iOOOOOO 
RETURN 

245 IC0DE=IC0DE+4000000 

RETURN 

255 iCODE=lCOD£+20GOOOO 
RETURN 

260 IC0DE--1 


RETURN 

END 
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o n n o 


CCGDLOO 

SUBftQUTIME CODLDaiMAHEfHrlMITALi 
PURPOSE; LOAD NAME ARRAYS WITH DEFAULT NAMES. 

CALL sequence: NAME - N X 1 NAME ARRAY* 

N “ NO^ OF NAMES IN ARRAY- 

INITAL = INITIAL CHARACTER HORD- 

REAL NAMECN) 

C SCAN NAMES* 

DO lOD X-lfN 
C BLANK DUT NAME. 

NAME(1)-10H 

C PUT INITIAL CHARACTER IN 1ST CHARACTER OF NAME- 
CALL PUTTlNAMEUJylrlNITALi 
C CONVERT I TO BCD* 

ENCODEllOflltNUMU 
11 FORMAT t I 10) 

K=2 

C SCAN CHARACTERS QF NUH FOR if^MERIC VALUE. 

DO SO U=lyiO 

C GET JTH CHARACTER OF NUM- 
CALL G£TTtNUM,J,KAR) 

C TEST FOR BLANK CHARACTERS AND SKIP THESE. 

IFtKAR.EQ.lOH } GO TO 50 

C LOAD NON-BLANK CHARACTERS CONTAINING NUMERIC INTO NAHE- 
CALL PUTT CNAHEtl),K,KARj 
K=K-M 

50 CONTINUE 
100 CONTINUE 
RETURN 
END 
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CDIFSUB 

OVER LAY £ NONS IH,4 T 2 } 

PROGRAM DIFSUB 

C PURPOSE: PERFORM NUMERICAL INTEGRA TIDfi USING GEAR ALGOR ITHIH 

C VERSION 2*3 REVISED: MARCH 23 1976 

COMHON/CTIH E/TIKE/CX/X i 1 i/ERMESS/lFATAL r I ERR 
COHHON/CSIHOL/DUHC 6 } ,TINC,TKAX 
COMHDN/CORQ ER/NS IM 9 NOV , NOP 
COMMm/CWORK/Wl 1 ) 

COMMON /CDIFS/JSTARTfKINiT,TP 
C IF FIRST CALL - INITIALIZE PARAMETERS 

IFCvJ START .NE-OJ GO TO 9 
TIMD=TIME 
HKAX-TINC 

HHIN=AMIN1£1«£"3,TINC/10000-) 

H=HMIN*100. 

MAXDER =6 

£PS=I»£-a5 

ND=NSIM 

Hl=i 

MZ=8^D-3-i 

H3=H2*H2?{'ND 

M4=H3+ND 

M5=H4+ND 

DO 5 I-I 5 NSIM 

5 WCM3-1+IJ=AMAXI61* ,ABS(Xtin } 

CALL XFR£X9W,5$SIM> 

C CHECK IF NEXT STEP WOULD INCREASE TIME PAST TP 

9 TIHE=TIHD 

10 CALL DiFSU2£NSIM?TIMDsW£HlS,WtH2) ,H,HHIN*HMAX»EPS»W£H3S,vaM4J ^ 
1KINIT?JSTART,MAXDER,W£HS3,NDJ 
1F£KI«IT.LE.0> GO TO 30 
IF£TIMO.&E-TP)GO TO 15 
GO TQ 9 

15 HE-tTP-TIMDl/H 

HEJ=H£ 

CALL XFRtWjXjNSIM) 

DO 19 I=1,JSTART 
DO 17 J=I»NSIM 

17 X( JI=X(J}+H£i=4=NSIM+J)*HEJ 

19 HEJ=HEJ*H£ 

TIME=TP 

C — TURN ON ERROR MESSAGES IN MODEL 

XERR=1 

CALL EOMOCTIMEjHjOJ 

C TURN OFF ERROR MESSAGES IM MODEL 

IERR=0 
GO TO 100 

30 COMTIMUE 
HRITE£6,51JTIMEyH»JSTART 

31 F0RMAT(//5X,*DR0PPE0 BACK TO RUNGI^KUTTA METHOD FOR 100 STEPS AT: 9 

iTIHE=*»G13-57* STEP SIZ£=’S‘yGI3,57 * □RDER==J‘j 13 1 

DO 32 I=l»NSIM 
J=M4-l+i 

32 W£ JJ =W( JJ/WCM3-1+I) 

WRITE(6,33J {HCMA-l-i-njI^lyNSIM) 

33 F0RHAT£/50X9=J=RELAT1VE £RRORS=«'/10tG13-5) 3 
WRITE16734J CmMS-l-HI bI=I,NSIMJ 
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34 F0aMATI/30X#*HAX STATE* » SIWCE LAST Tim IMT£RVAL=$=/ 

1 10C&13.i)>) 

KIMIT^O 

JSTART=0 

CALL XFR(M*X,NSrM} 

100 CDMTiaiUE 
B*D 
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CDIFSU2 

SUBRDUriNi£ DIFSU2^f^^T^Y9SAVE^H»H^5Ifii5HMAX,EPSffYMAXf ERROR, 

X KFLAGsJSTART^MAXOERjPWtfSD} 

C VERSIOM 2, REVISEDs JAN 7 1976 

C N THE NUMBER OF FXRST ORDER EQUATIONS 

C MAY BE DECREASED ON LATER CALLS IF NUMBER OF ACTIVE EQUATIONS REDU 

C BUT IT MUST NOT BE INCREASED WITHOUT CALLING WITH JSTART = 0, 

c ms fulil dimension of state vector 
C 1 INDEPENDENT VARIABLE 

C Y 8*N VECTOR CONTAINING DEPENDENT VARIABLES AND SCALED DERIVATIVES 

C YlI-HJ^l CONTAINS J-TH DERIVATIVE OF Y( I), SCALED BY 

C ONLY YCX) NEED BE PROVIDED BY CALLING PROGRAM ON FIRST ENTRY 

C 

C IF INTERPOLATION TO NON MESH POIiffiTS IS DESIRED AT T+E AND CURRENT 

C STEP SI£E IS HfiLET S = E/H AND COMPUTE tYlHT-t-EJ - SUM Y(I’J-J*NJ^J=S^ 

C FROM J=0 TO J=NQ 

C SAVE AT LEAST 12=«=N LOCATIONS 

C H STEP SIZE TO BE ATTEMPTED ON THE NEXT STEP- 

C IF VALUE PROVIDED BY THE USER DDES NOT CAUSE A LARGER ERROR THAN K 

C IT WILL BE USED- THE USER IS ADVISED TO USE A SMALL STEP FOR FIRST 

C HMIN MIN STEP SIZE 

C HHAX MAX STEP SIZE 

C EPS ERROR TEST CONSTANT™ SINGLE STEP ERROR ESTIMATES DIVIDED BY YMAXl 
C MUST BE LESS THAN EPS IN EUCLIDEAN NORM- 

C YMAX iN) ARRAY CONTAINING MAX SO FAR. NORMALLY SET TO 1 BEFORE FIRST E 
C ERROR (N) ARRAY CONTAINING ESTIMATED ONE STEP ERROR 
C KFLAG A COMPLETION CODE 
C +1 STEP WAS SUCCESFUL, 

C -I STEP TAKEN WITH H = HMIN tBUT REQUESTED ACCURACY NOT ACH 

C -2 MAXIMUM ORDER SPECIFIED MAS FOUND TO BE TOO LARGE 

C -3 CORRECTOR CONVERGENCE COULD NOT BE ACHIEVED FOR H-G7.HMI 

C -4 REQUESTED ERROR IS SMALLER THAN CAN BE HANDLED 

C JSTART AM INPUT INDICATOR 

C -1 REPEAT THE AST STEP WITH A NEW H 

C 0 PERFORM THE FIRST STEP 

C -t-i TAKE A NEW STEP CONTINUING FROM THE LAST 

C JSTART IS SET TO NQ, THE CURRENT ORDER OF THE METHOD AT EXIT. 

C NQ IS ALSO THE ORDER OF THE MAXIMUM DERIVATIVE AVAILABLE. 

C IT MUST BE LESS THAN o OR 7 FDR ADAMS OR STIFF METHODS RESPECTI 

C MAXDER THE MAXIMUM DERIVATIVE THAT SHOULD BE USED 
C PW ■ A BLOCK OF AT LEAST N**2 FLOATING POINT LOCATIONS. 

COMMON /CX/XC1> /CXDOT/XDOTdJ 

DIMENSION YUJ jYHAXQ) »SAVEail ,ERRORf 1) ,PMEiJ , 

1 A(8)5pERTST(7r3) 

DATA PERTST /2-0, 4.5, 7-333, 10. 42, 13. 7, 17-15, 1.0, 

1 3»0,6b0,9ib1 67 ,12.5, 15 —98,1.0,1.0, 

1 l.,l., 0-5, a -1667, 0.04133, 0.008267,1.0/ 

DATA AC 2) / -'1.0/ 

IRET -1 
FPZ=1.E-15 
KFLAG = 1 

IF C JSTART. LE-0) GO TO 140 
100 DO 110 J=i,K 
JJ={J-1J=»=ND 
DO 110 I = l,it 
110 SAVEC JJ+I)=YC JJ+I) 

HOLD = HNEH 

IF CH.EQ.HOLDl GO TO 130 
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120 RACUH =H/HDLD 
IRETl =1 
GO TO 750 

130 NQQLD = NQ 
TOLD = T 
RACUM = 1.0 

IF {JSTART-GT-0) GO TO 250 
GO TO 170 

140 IF t JSTART-EQ--1) GO TO 160 
NQ = 1 
Hi = HD 
N1 = N*10 
N2 = N1 + 1 
N5 = Ml + MD 
NS=S=^MD 
N9=9=^=MD 
ME=MD^2+1 
N6 = N5 + 1 
CALL XFR(Y,X,N) 

CALL EQM0tT,H901 
DO 150 I - L,M 

150 Y{ND+I) = XDOTtD’t^H 
HN£W - H 
K = 2 
GO TO 100 

160 IF CMQ.EQ-MQOLOl JSTART = 1 
T = TOLD 
MQ = NQDLD 
K = NQ 4- 1 
GO TO 120 

170 IF (NQ.GT.6) GO TO 190 

GO TO 1221, 222,223, 224, 225, 226), NQ 

190 KFLAG = -2 
RETURN 

221 All) = -1. 

GO TO 230 

222 AU) = 6060 2525 2525 2525 2525S 

A(3J = 6061 2525 2525 2525 25258 

GO TO 230 

223 ACl) = 6060 3505 6427 2135 05643 

A£3) = Ati) 

AC4) = 6063 2135 0564 2721 3506B 

GO TO 230 

224 A(l) = 6061 0243 6560 5075 3412B 

At 3) = 6060 2314 6314 6314 6315B 

At 4) = 6062 1463 1463 1463 1463B 

A I 5) - 6065 2702 4365 6050 7534B 

GO TO 230 

225 A(l) = 6061 0774 2064 2443 40163 

At 3) = 6060 1334 3761 0321 2215B 

A (4) = 6061 3022 5372 3116 3664E 

At 5) = 6064 0774 2064 2443 40163 

At 6) = 6070 0415 0510 7003 5713B 

GO TO 230 

226 Ati) = 6061 1360 2471 3602 4713B 

A«3) = 6060 0505 0505 0505 0505B 

A (4) = 6061 1252 5252 5252 5253B 

A{5> - 6063 1515 1515 1515 1515B 
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A(6) = 6066 1717 1717 1717 1717B 

ACT) = 6072 3266 2155 1043 7732B 

230 K “ K«Q + 1 
IDQU3 = K 

£NQ2 = .5/FLOAT tMQ i- 1) 

EiaQ3 = .5/FLeAT(NQ ?.} 

ENQl = 0.5/FLDATCNQ) 

PEPSH “ EPS 

EUP = f P£RTST(NQ,2)4:pEPSH)^^2 
(PERTSTCJ4Q,1)*P£PSH)^2 
EOWN =tPERTSTCNa»3)=5:pEPSH)=fr*«=2 
IF CEDWN-EQ.OJ GO TO 780 
BND = EPS*EMQ3/ FLOAT CM) 

240 IWeVAL =2 

GO TO £ 250 , 680 ),IRET 
250 T = T -i- H 

DO 260 J — 2 jf K 
DO 260 Jl - J,K 

J2 = £K -J1 -i- J - 2}=J=N0 
J3=J2+ND 
DO 260 I = isM 
260 Yt J2+I)~YU2+Il-s-Y£J3+Il 
DO 270 1 = isN 
270 ERRORt.1) = 0-0 
BO 430 L = 1,3 
CALL XFR(Y,X,i4) 

CALL EQMOCT,HtO) 

CALL XFRCXD0T,SAV£CN2J ,hJ) 

IF t IWEVAL -LT.U GO TO 350 
GO TO 310 
290 Nil N3 + 1 

N12 = N*I^I1 - m 
DO 300 I = 

300 PWtlJ = 1.0 + PWCIJ 
IWEVAL == -1 

CALL LUEQStPW.KKyKKsPWCNE) ,N,0,ND,l,l,FP2?Ji) 

IFCJl.Eti-0) GO TO 350 
GO TO 440 

310 00 320 I = 1,M 
320 SAVEtNS+I) - YUJ 
00 340 J = 1,N 

R = EPS* AMAXl£EPS,ABStSAVEtN8+J)n 
Y£J) = YCJ) + R 
D = A£i)*H/R 
l^ll==CJ-l)*ND 
CALL XFR£Y,X,!Nl) 

CALL £QM0{T,H,0) 

CALL XFR£X0QT,SAVEiN6l,M) 

DO 330 I = 1,N 

330 PW(Nli4-I) = CSAVE£N5+I> - SAVECNl-*-! J1*D 
340 YIJ) = SAVEIN8+J) 

GO TO 290 
350 CONTINUE 
370 DO 380 I “ 1,N 

380 SAVE£N5+I) = YCND-i-I) - SAVEIN1+I)*H 

CALL SLVEQCPW,SAVE{Na+li,SAVECN6S5pW(NE),NplfND,N,NTFPZ,3i) 
410 NT = N 

DO A-20 I = 1,N 
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Y(I) - Ytn + AU)4=SAVEtMa+IJ 
YCffiD+IJ = YCND+II " SAVEfN8+Il 
ERRORCI) = ERRDRUJ + SAVEIN8+I) 

IF (ASSlSAVt(f484-I)) .LE.tBND =S= YMAXiUH NT = NT - 1 
420 CONTINUE 

IF (NT„LE.O) GO TO 490 
430 CONTINUE 
440 T = T “ H 

IF UH.LE. {HHIN'4'l*00t30X) )»ANQ. CUWEVAL - 2l.LT-*~in GO TO 460 
IF ( iWEVAL^ME.Oi RACUH = RACUM *0«25 
IWEVAL -Z 
IRETI = 2 
GQ TO 750 
460 KFLAG = “3 
470 DO 480 J=L,K 
J-11=)NND 
DO 4S0 1=1, N 

480 YtJJ-s-I) = SAVE(JJ+I1 
H = HOLD 
NQ = NQQLD 
JSTART = m 
RETUPi« 

490 D = Q-0 

DO 500 I = 1,N 

500 D = D -i- tERRORdJ/YMAXC II )=i=^2 
IWEVAL = 0 

IF (D-GT-E) GO TO 540 
IF CK.LT.3) GO 10 520 
DO 510 J = 3,R 
JJ=t J“1>*ND 

DO 510 I = 1,N 

510 YCJJ + I) = Y(JJ+IJ + A( J14=ERR0R(I» 

520 KFLAG = +1 
HNtEtf = H 

IF tIDQUB,LE-i) GO TO 550 
IDOUB = IDOUS - i 
IF {IDOUB.GT.D GO TO 700 
DO 530 I = 1,N 
530 SAVES N9-M) = ERRORS II 
GO TO 700 

540 KFLAG = KFLAG - 2 

IF {H-LE.(HHIN+l,0000iJ ) GO TO 740 
T = TOLD 

IF tKFLAG.LE.-5) GO TO 720 
550 PR2 = lD/El**ejQ24i.2 
FR3 = l.E+20 

IF £ (NQ-GE-MAXDER) .OR. tKFLAG-LE-“i) ) GO TO 570 
D = 0.0 

DO 560 I = 1,N 

560 D = D -I* I C ERROR! I > - SAVECN9+I J )/yHAX£in^^2 
PR3 = tD/£UP)**EWQ3*l-4 
570 PRl = l.E+20 

IF (NQ.LE.l) GO TO 590 
D = 0.0 
JJ=(K-1)+W0 
DO 380 I = l;,N 

580 D = D + lY(JJ+n/YMAX£l>)=4=*2 
PRl = £D/£DHNi=i^ENQl*1.3 


84 


BCS 40262-2 


590 COOTINUE 

IF {TO2.LE.PR3J GO TO 650 
IF (PR3,LT«PR1) GO TO 6&© 

600 R = 1.0/AMAXlSPRiti«E-4) 

NEWQ = NQ - 1 
610 IDQUB =10 

IF { {KFLAG-EQ«ll.AND*CR.LT,£l,i» )J GO TO TOO 
IF (MEWQ«L£-NQJ GO TO 630 
JJ=NEWQ=5:ND 
DO 620 I = 

620 YCJJ+I5 = ERROR{I?^ACK|/FLQAT£KJ 
630 K=N£WQ+i 

IF (KFLAG-EQ-U GO TO 670 
RACUH = RAGUH^R 
IRETl =3 
GO TO 750 

64-0 IF iPifcWQ-EQ-lMQJ GO TO 250 
WO = NEWQ 
GO TO 170 

650 IF {PR2-GT*PR1J GO TO 600 
NEWQ = NQ 

R = l»0/AMAXltPR2,l.£-4'J 
GO TO 610 

660 R = i-0/AMAXliPR3,l„E-4I 
NEHQ = NQ + 1 
GO TO 610 
670 IRET = 2 

R = mXMi£R,HMAX/ASSfHn 
H = H^R 
HWEW = H 

IF fMQ-EQ.NEWQI GO TO 680 
NQ = NEWQ 
GO TO 170 
680 R1 = I-O 

DO 690 J = 2,K 
Ri = R1*R 
JJ=t J-U*&=ND 

DO 690 I = 1»M 

690 Y£JJ+I) = Y(JJ^IJ=i^Ri 

IDQUa = K 

700 DO 710 I = IsN 

710 YMAXtIl = AMAXltYMAX{I),ABS(Y(in J 
JSTART = NQ 
RETURN 

720 IF £?«Q-£Q,1) GO TO 780 
CALL XFRlYjXjfti) 

CALL EQMDtTyHyO) 

CALL XFR{XD0TrSAVE{N2),ri) 

R = H/HDLD 
DO 730 I = 1*N 
YU) = SAVE(U 

SAVECND-i-I} = HQLD=8=SAyE«Ml-*-i) 

730 Y£ND+I) == SAVEtND+IS^i'R 
NQ = 1 
KFLAG - 1 
GO TO 170 
7A-0 KFLAG = -1 
F*«EW = H 
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JSTAR.T == NQ 
RETLERN 

750 RACU« = AMAXUABSCHHIN/HQLD) ,RACUH) 
RACUH = AMINl(RACUM,ABSCHKAX/HOLDi] 
Rl. - 1»Q 
DD 760 J = 2,1c 
R1 - R1=«=RAGUM 
JJ=IJ-1)*ND 
DO 760 I = 1»N 

760 Y(JJ+I) = SAVE(JJ-H}*Ri 
H - HDLD’i=RACUH 
DO 770 I = IfM 
770 Yd) = SAVE(I) 

IDOOS = K 

GO TO (130 , 250 , 640 ) ,IRET1 
780 KFLA& = --4 
GO TO 470 
END 
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CDISPLA 

SUBROUTIi^E DISPLA( IDSPLY»IPHRS,HODE»ICQL) 

purpdse: imterprets input data phrases that describe graphic display 


CALL SEQUENCE: 


IDSPLY = DISPLAY HUMBER « 

iPHRS = PHRASE TO BE INTERPRETED^ 

MODE = MODE - 1,2»3 INDICATES THAT VStYRANGEtQR 

XRANGE RESPECTIVELY VfAS THE LAST IHITRUCTION. 
ICOL = SET EQUAL TO THE COLUMJtf NUMBER IN SCALE. 


CQHM0N/CSCALE/SCAL£(5,A,6J ,NVARC5,2,6),NPLTSt6J 
REAL NVAR» IPHRS, LIST (3 J 

DATA LIST/30HVS YRANGE XRANEE / 

C CURRENT NUMBER OF PLOTS/DISPLAY. 

i*PLT=i!iPLTSt IDSPLY) 

C SEARCH FOR COMMAND WORD- 

CALL LCHPH£IPHR$,LISTr3,l,IC0DEJ 
IFtIGODE»LE-0> GO TO 20 

C SAVE ICDDE IN MODE AND BRANCH TO SET ICDL IF REQUIRED- 


MODE=ICODE 

GO TO {i00,2ej0B3CG),IC0DE 
C TEST FOR NUMERIC PHRASE- 
20 CALL NUHERCC IPHRS) ^RETURNS 160) 
IFlMQDE-LE-2) GO TO 40 
C CONVERT X SCALE FROM A TO G FORMAT. 

CALL aCDREL i SCALfc£NPLT ,ICDL» IDSPLY J t IPHRS ) 
IC0L=4 


RETURN 

C CONVERT Y SCALE FROM A TO G FORMAT. 

40 CALL BCORELtSCAL£tNPLT,ICOL,IDSPLY)5lPHRS) 

IC0L=2 
RETURN 

60 IFIMODE-EQ-L) GO TO 80 

NPLT=MIN0iNPLT+l,3) 

NPLTSC IDSPLY J=«PLT 
C LOAD Y AXIS NAME. 

NVAR(NPLT,1*IDSPLY)=IPHRS 
GO TO 90 

C LOAD X AXIS iiAME- 
80 NVARtNPLT,2,IDSPLY)=lPHRS 

90 MODE=-i 

100 RETURN 

C SET column INDICATOR TO 1 FDR YRANSE- 
200 iCOL-1 
RETURN 

C SET COLUMN INDICATOR TO 3 FDR XRANGE- 
300 IC0L=3 
RETURN 
END 
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CDTTIM 

SUBROUTINE DTTIM CAJ 
C 

C GET THE CURRENT DATE AND TIME 
C 

DIMENSION A(l) 

AM) = DATE( IS 
A (2) - TIHECi} 

RETURN 

END 
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CEGVL3 

SUBROUTINE EGVL3(A,S,ER?EI , lA, DWyFPZ,NA»HA) 

SUBROUTINE TO COMPUTE EIGENVALUES OF A 
INPUTS are; 

A THE SYSTEM MATRIX HHICH IS UNALTERED BY THIS PROGRAM 
NA THE ORDER OF THE SYSTEM 
HA THE ROW DIMENSION OF THE MATRIX A 
FPZ THE PRECISION INDICAIQR 

ON SUCCESSFUL COMPLETION UERROR-0) 

ER CONTAINS TH/E REAL PARTS OF THE EIGENVALUES 
El CONTAINS THE IMAGINARY PARTS OF THE EIGENVALUES 

DIMENSION INFURHATION 
B IS A NA^^*2 VECTOR 

IAtIB,ICtID»0M are NA LENGTH WORK VECTORS 

THIS PROGRAM WAS DESIGNED AND CODED BY A- FREDERICK PATH DF 
SOEING COMPUTER SERVICES, SEATTLE, WASHINGTON. THIS VERSION 
WAS COMPLETED DURING APRIL 1975. 

DIMENSION A{HA,U,tRUl,EI li ) , St i ) ,I AU I , IB 1 1) , ICl U ,ID( I ) ,DHm 
IERRDR=0 

CALL PREC2{AtB,DW,lA,IB,ICpiD,NSM,NA,MA> 

CALL THSa2|B,2C,lD,NA,HAJ 
CALL EVCHB(B,ER,E1 ,ICtFPZ,NSM,MA,IERROR) 

RETURN 
END 
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CEQYCL 

SUBROUTINE cQVCLfN,NDIMsA,IPERHfNIX,ISTACK,I£QUIV,LOC) 


PROGRAM TD DETECT AND ISOLATE EQUIVALENCE CLASSES UNDER 
REACHABILITY WITHIN A GRAPH f GIVEN A COI^ECTIDN MATRIX OF 
THE GRAPH- THE OUTPUT IS AVAILABLE IM STACK AND EQUIV- 


DESIENED BY E. HCCREIGHTt NOVEMBER, 1969- 
INFORHATIDN SCIENCES LABORATORY 
BOEING SCIENTIFIC RESEARCH LABORATORIES 
SEATTLE, WASHlNGTCft« 

DIMENSION A(NDIM,NDlH),ISTACKtNDlM),LOCtNDlMJ ,IEQUIV{NDIM J 
DIMENSION IPERM(NDIM) 

INITIALIZE THE VECTORS WHICH INDICATE THE EQUIVALENCES DISCOVERED 
AND THE ROWS COMPLETELY OR PARTIALLY PROCESSED- 


ISTKP^l 
IEQCP=N 
DO 8003 1=1, N 
8003 L0C£I)=0 

TRY TO HAKE EACH ROW li* SUCCESSION THE ROOT OF A DEPENDE^UCY TREE- 


1=1 

8000 CONTINUE 

HAS THIS ROW ALREADY BEEN PROCESSED 
IF CLQCLI)-EQ."13 GO TO 8100 


START AT THE LEFT DF THE ROW AND WORK TD THE RIGHT- 


&00A J=I 

LOC(I}=ISTKP 

IEQUIVCI>=I 

READ ACROSS THE ROW- WHEN YOU COME TO A NON-ZERD ENTRY, BREAK 
OUT. 

8005 IX1=IPERM£I) 

DO 8010 K=J,N 

IF CA(IXi,IPERH{Kn-EQ-0-D0) GD TO 8010 


DID ME DISCOVER I TO BE EQUIVALENT TO ITSELF WE ALREADY KNEW 
THAT. 

8020 IF IK-EQ-I) GO TD SOlO 

DID WE DISCOVER I TD POINT TO SOME ROW WHICH WE HAVE ALREADY AT 
LEAST PARTIALLY PROCESSED THIS IMPLIES THAT I IS EQUIVALENT TD 
THE LOWEST ROW TO WHICH THAT ROW IS EQUIVALENT, IF THAT ROW IS 
STILL IN THE STACK. 
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C 


IF tLOGCKJ.NE.OJ GO TO 8050 


DID WE DISCOVER. I TO POINT TO SOME R0« WHICH HAS NEVER BEEN 
UNDER CONSIDERATION IF SO, INTERRUPT EVERYTHING AND CONSIDER IT 
NOW- 

ISTACKIISTKP)-! 

ISTKP=ISTKP+1 

I-K 

GO TO 8004 

FIND THE LOWEST ROW TO WHICH ROW K IS EQUIVALENT. IF THIS LOWEST 
ROW IS STILL IN THE SYACKr SEE IF IT IS THE LOWEST ROW IN THE ST- 
ACK TO WHICH WE KNOW ROW I TO BE EQUIVALENT. 

b050 IF (LOCCKl.GT.O) &D TO 8051 
Ki=IEQUIV(K) 

IF ILOCtKi) -LE.O) GO TO 80X0 
GO TO 3052 
fa051 K1=K 

6052 IF iLOCtKl) .GE.LQCCIEQUIVUHJ GO TO 8010 
IEQUIVII1=KX 
80X0 CONTINUE 

THE READ ACROSS ROW I IS COMPLETE- IMDICATE THIS. 

80X5 LQCtlI=~I 

TRY TO MOVE BACK TOWARD THE ROOT ROW- IF THIS IS THE RDDT ROW, 
THEM SELECT A NEW ROOT ROM AND MOVE THIS ROW TO THE OUTPUT QUEUE. 

8014 IF (ISTKP-EQ.U GO TO 6090 
ISTKP=ISTKP-1 


SET UP ROW I WITH ITS NEW EQUIVALENCE AND TEST WHETHER THE EQUIV- 
ALESiCE iS TRIVIAL- 

8016 K2=I£QU1V(IJ 
8019 IRV=1 

IF lIEQUIVlI)-EQ-n GO TO 8091 


SEE IF THE BEST EQUIVALEMCE NOW KNOWN FDR ROW I IS IN FACT BETTER 
THAN THE BEST KNOWN EQUIVALENCE FOR I=4=S FATHER AS WELL. IF SO, 
RECORD IT IN THE VECTOR LOHST- 

Ki^ISTACKUSTKPS 

IF (LOCUEQUIV£Kin.LT.LOCiK2) ) GO TO 80LB 
IEQUIV£KXI=K2 
SOIS CONTINUE 

NOW COMPUTE THE TRANSITIVE CLOSURE OF THIS NEW EQUIVALENCE CLASS. 
DO 6017 K1=1,N 

IF £IEQUIV(K1}-EQ-IJ IEQUIV(K1)=K2 
8017 CONTINUE 
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BACK UP TOWARD THE ROOT, USIMG THE STACK TO GUIDE US» 


8024 J=I+1 

MSTACKlISTKPi 
IF tJ.GT.NJ GO ID 8015 
GO TO 8005 


EHTER THE CAHONICAL ELEMENT OF AN EQUIVALENCE CLASS INTO THE 
QUEUE OF SUCH ELEMENTS- IF THE QUEUE IS EMPTY, INITIALIZE IT- 
OTHERWISE ENTER OUR NEW ELEMENT AT THE TAIL- 

a090 IRV-2 
8091 ISTACKIIEQCP1=I 
IEQCP=IEQCP-1 
GO TO C8024,8100},IRV 

END OF MAIN LODP- 

8100 IFtl-GE-N) GO TO 8104 
1 = 1+1 

GO TO 8000 

8104 CONTIa«U£ 

NOW TRANSFORM THE EQUIVALENCE CLASSES TO PATH NORMAL FORM: 
CONTIGUOUS PARTITION BLOCKS IN OUTl WITH THEIR SIZES IN 0UT2. 

FIRST FORM A CHAIN FOR EACH EQUIVALENCE CLASS- 

00 8105 I=i,N 

8105 L0C(IJ=0 

DO 8110 1=1, M 
J=I£QUIVi2) 

IF tJ-EQ-IJ GO TO 6110 
LQCEI)=LOCi JJ 
LOC£ J)=I 
Olio CONTINUE 

NOW PROCEED THROUGH THE EQUIVALENCE CLASSES LISTED If* THE QUEUE, 
ENUMERATING EACH EQUIVALENCE CLASS INTO THE QUEUE STACK, AND 
COUNTING EACH CLASS INTO QUEUE EQUIV- 

IQIX=1 

NIX=1 

Sill IF IIEQCP-EQ-MJ GO TO 8120 
IEQCP=lEQCP+i 
I=ISTACK(IEQCP) 

U=LOCCIi 
ISTACKC 101X1=1 
IEQUIV(NIX)=1 
8115 I0IX=I0iX+l 

IF CJ-EQ.OJ GO TO 8119 
rSTACK«IOIXI=J 
IEQUlveNlX)=IEQUlVCNlX)+l 
U=LQCCJ) 

GO TO 8115 
8119 NIX=NIX+I 
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GO TO Bill 
8120 CQJ4TINIUE 

RETURM 

EN[D 
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CtVAL2: 


SUBROUTINE EVALZtXTfMpFUN, PfRMSjFI 
VERSION 3. REVISEDs JUNE 4 1976 

PURPOSES EVALUAIE MODEL RATES AND CALCULATE THEIR RMS VALUE 


CALL SegUENCtS 


XT 

N 

FUN 

P 

RHS 

F 


CEQHO} 


STATE VECTOR 
TOTAL NUMBER OF STATES 
FUNCTION TO EVALUATE RATES 
tNOT USEDJ 
RHS VALUE OF RATES 
■ RATES 8RESIDULESJ 
COMM ON /CX/X 1 1 J /CXDOT/XDDl ( i ) /Cl NT/ INT U ) /CT iME/TIME 
DIMENSION XTtiJ,FU> 

J=0 


DO 100 I=1»N 

IFUNTIIJ -EQ-OIGC TO 100 
J-J-M 
X{I)=XT( J) 
iOO CONTINUE 

CALL FUMtTIME*TiME»ll 

RMS = 0- 

J=0 

DO 110 1=1, N 

IFilNTSD-EQ-OJGO TO liO 
J=J+l 

FCJ) =XDQTtIJ 
RHS = RMS+FtJ)=S^FtJ J 
110 CONTINUE 

RMS = SQRT(RMS) 

RETURN 


END 
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CSVCHB 

SUBROUTINE EVCHSEAjEVRsEViflCtFPZjNSHsHMy lERRDR) 

subroutxwe to calculate eigenvalues qf matrix a 

AND RETURN THE REAL PARTS IN EVR AND THE IMAGINARY PARTS IN EVI- 
IC IS THE SLOCKING INFORMATION VECTOR INDICATING THE IRREDUCIBLE 
BLOCKS CONTAlNiSSftG THE EIGENVECTORS OF A» 

NSH IS THE NUMBER OF SUCH BLOCKS- 
MM IS THE ROW DIMENSION A 

QR ALGORITHM FROM COMPUTER J-s VOL- 11* MUM-1, 

MAY 196S, PP- 112-114, ALGORITHM 32 BY GRAD, REDISH, BREBMER 
MODIFIED TO PREVENT SHIFT CYCLING. 

FP2 IS FINITE PRECISION ZERO 

THIS PROGRAM MAS DESIGNED AND CODED BY A- FREDERICK PATH OF 
BOEIJ^G COMPUTER SERVICES, SEATTLE, WASHINGTON- THIS VERSION 
WAS COMPLETED DURING APRIL 1975. 

DIMENSION ACMM,1),EVR(1),EVI(1J jlCtlJ 
JT=i 

ICOUNT =0 
IERRDR=0 
DO 35Q IT-1, NSM 
IFUT-EQ-11 GO TO 320 
JT=ICaT-ll +1 
320 KT=IC{IT)-JT+I 

IFlKl-NE-i) GO TO 340 
EVRlJT)=AtJT,JT) 

£VI UT)=0- 
GQ TO 350 
340 IA=J1 
NA=KT 

9 SHIFT=0. 

N=IA-tNA-l 
MAXST=NA=*10 

IF{ACN,NJ -NE-0. ) GO TO 1 
IF(NA-LE.2J GO TO 1 
IFlAlN-"l,N-l)-NE-0-l GO TO 1 
IF{A(N“1,N) oNE.O.) GO TO 1 
SHIFT=A(N,N-1I 

1 X=0- 
DO 5 K=IA,N 
IFtK-ME-IA) GO TO 2 
M=IA 
GO TO 3 

2 M=K-i 

3 DO 5 I=H,» 

5 X=X-i-A(K,Il*^2 

E=SQRTtXl 
ARB=E/tN-IA) 

£-E*FPZ 
M=N ■ 

NS=0 
NS0LD=0 
151 XP=1 

IF(M-1-GE.1JQLD]L=ABSIA(M,H-I3B-M. 

IFCH-2-GE-1I DLD2=ABS[ ASM-1, M-Zn-M- 

10 K=M-1 
M1=K 
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I=K 

IFiK“IA+l) 99,11,1^2 
12 IFtM~2-£Q,0J GD TO 13 

IF{A8SCACH,K1 )»LE»c) GO TO 11 
16 1=1-1 

IFCAc>S(ACK,i))oL£»£) GO TO 17 
K=I 

IFCK-GT.IA} GO TO 16 

17 IFCK«EO-Hi) GD TO 13 

IF{IP.eQ.2) GO TO 153 

IFtABStAtMfMi)) .LT.OLDll GO TO 155 
IP=2 

153 IFtABStACMl,Hl-]U),LT*DLD2) GO TO 154 
IP=I 

XFtMS-LT.NSQLD+41 GO TO 157 

NSOLO=NS 

S=ARB 

R=0- 

GQ TO 156 

155 OLDI=ABS[A£M,HU J 

154 DLD2=ABStAlMl»Mi-in 
157 CONTINUE 

S=A£K,HJ+AtMl»HU‘f*SHIFT 

R=A£«5MJ*A(Hl,Hl)-AtM,Ml)^A£Hl,H}-t-SHIFT=S^2=^'-25 

156 A(K-t-2,K)=0. 
l=K+i 

X=A(K,K)={'{ACK,K)-SJ+R-*-AtK»I)=^Aa,K) 

Y=A(I,KJ*tA(KtKl+A£ 

I=AJK.^-2,1)^A{I,K.) 

SHIrT=0- 

NS=NS+i 

ICOUNT=ICQUNT + iH-K)*=4=2 
DO 29 I=K,M1 
11 = 1+1 
12 = 1+2 
13=1+3 

IFfl-EQ.K) GO TO IB 
X=A£ 

Y=A{IirI-i) 

IFII2.LE.M) GD TO 19 
Z=0« 

GO Tu 18 

19 Z=AlI2»I-ll 

la S=SQRTC X=fc=*=2+Y^^2+Zt=^=2) 

SR=S 

IF(X«LT-0.} GO TO 20 

s=-s 

20 IFII-EQ-KJ GO TO 21 
A(I,I-11=S 

21 IF(SR-G£«E*l-E-05} GO TO 30 
IF£I3-GT-MJ GO TO 29 

GO TO 28 
30 AL=I.“X/S 
S=X-S 

x=y/s 

Y=Z/S 

DO 23 J=IyM 

S=A( I,JJ+AtIl,JJ=S^X 
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IFII2.GT.H) GO TO 22 
S=S+AC12»J}*Y 

22 S=S*AL 
ACI,J}=AI 

A{Il3J)=AtIl,J)-S*X 
lFtI2«GT«H) GO TO 23 
A[I2,JJ=A£I2,J)-S*Y 

23 CONTINUE 
L=I2 

rF(I.LT*Mi) GO TO 24 
L=M 

24 DO 26 J=K»L 
S=A{ J,II+AC 
iFa2«&T*M) GO TO 25 
S-S+A1J,I2>^Y 

25 S=S*AL 
ACJ7X)=AlJ¥l)-S 
A{J,I1)=A£J,IX)-S*X 
iF(I2.GT-M) GO TO 26 
A( J,X2S=A£JsI2l-S=J=Y 

26 CONTINUE 
IF£I3,GT,M} GO TO 29 
S=-A(I3,I2)=f=YML 

23 ACI3,I)=S 

A£I3,I1)=S4=X 
At r3,I2>=S=S'Y+AtI3sI2) 

29 CONTINUE 

IFtNS,GT„HAXSn GO TO 6 
GO TO 10 

il EVR£M)=ACHiH) 

EVI(M)-0. 

H=K 

GO TO 151 

13 R=(A£KriU+AtH,H))/2, 

S=tA(H,NJ-AtK,KJ )/2. 

S=S=J=S+A t K 9M J 4=A 1 N# K ) 
iF(S»LT.O.) GO TO 14 
S=SQRT£S} 

EVRtKJ=R-S 

£VR(HJ=R^S 

EVI£K)=0. 

EVIC HING- 
IS M=H~2 

GO TO 151 

14 S-SQRTC-SJ 
£VR£K)=R 
EVR(H)=R 
EVIJKJ^S 
EVICM)=-S 
GO TO 15 

6 WRITES 69 7) HAXST 

7 FORMATt^O NO CONVERGENCE AFTER NUMBER OF QR ITERATIONS =4=yl6j 
IERR0R=1 

99 CONTINUE 
330 CONTINUE 
RETURN 
END 
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CfcVORDR 

SUBROUTINE EVORDRC EVR,EVr,lDjNLIN J 
PURPOSE: ORDER EIGEJ4VAUUES TO HAVE INCREASING NEGATIVE 

REAL PARTS - 

CALL SEQUENCES EVR - NLIN X L ARRAY REAL PARTS OF EIGENVALUES 

EVI “ NLIN X 1 ARRAY INAG- PARTS OF EIGENVALUES 

ID - NLIN X I IJfORK ARRAY 

NLIN - SYSTEM ORDER 

DESIGNED by: J«D. BURROUGHS FEB 1974 

DIMENSION EVRdl^EVKUjIDCO 
C ORDER EIGENVALUES 

CALL FSHELUEVR*ID,NLINS 
CALL SH EL LX ( EVI, ID f NLIN) 

C REVERSE EIGENVALUE ORDER 

NLIN1=NL1I4-Irl 

NLIN2s:NLIN/2 
DO 100 I=1,NL1N2 
I2-NLINI-I 
EVRS=eVRC I) 

EVIS=EVICI) 

£VR(U=cVR{I2J 
£VI(li-EVI(I2l 
EVRCI2):=EVRS 
iOO £VI(I2)=£VIS 
1=1 

120 iFtEVKIIJ 160,180,140 
140 1=1+2 

GO TO 200 

160 EVHI)=AbSt£VItm 
1=1+1 

EVK I3=-A8S(EVim ) 

180 1=1+1 

200 IF(I.LT.NLIN) GO TO 120 
RETURN 
END 
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CFSHELL 

SUbROUTIfiE FSHELL { IARRAY,KEY»f«? 
purpose: order m array to have IPfCREASIMG MAGNITUDE AND 
FORM KEY FOR ORDERING RS-ATED ARRAY- 
CALL SEQUENCE: IARRAY - N X 1 ARRAY OF VALUES TO BE SORTED 

KEY - N X 1 ARRAY OF KEYS FOR SORTING DEPENDENT 
ARRAY 

N - NUMBER OF ELEMENTS TO BE SORTED, 

DIMENSION lARRAYUlsKEYt 11 
DO 10 I-i,N 
10 KbY{I)=I 
M=N 

20 M-H/2 

IF(M)30t30t40 
30 RETURN 
4G K-N-M 

DO 70 J=1,K 
I=J 

5 0 11=1 -fM 

IFaARRAY£I)-IA RR A Y {111170,70,60 
60 LIH3D=IARRAY{I) 

IARRAY £ 1 1 =I ARRAY (III 
lARRAYUIl^LIMBO 
L1MS0=KEY£I) 

KEY{ I)=KEY[II) 

KEY£II)=LIHBO 
I=I-M 

IF{ 1)70,70,50 
70 CONTINUE 
GO TO 20 
END 
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CGANHAR 

SUBROUTINE GANMAR{NSIM*IACT,PARA»KMAXf IPOLEpGHDSPY* A tRATID, 

1 DW0RK»IATlB,ICilDfpaLE»£VR»EVI»XD0I05PaLES) ,RETURNS(R1I 
VERSION 2. revised; dec 23 1975 

PUR POSE i CALCULATE STA&ILITY MARGINS OF ONE OR MORE MODEL PARAMETERS 

CALL sequence; nsih - model order 

lACt - ARRAY OF SM PARAMETERS t IDENTIFICATION CODES J 
PARA “ ARRAY OF SH PARAMETERS {HOLLQRITH NAMES) 
KMAX - NUMBER OF SM PARAMETERS 

IPOLE - SPF IFIES IF STABILITY MATRIX MUST BE CALC. 
IIPOLE 0 CALC.) 

GMDSPY - ARRAY CONTAINING SM ANALYSIS RESULTS 


i£ 


DESCRIPTION 

LOCATION 

A 

- NSIM 

X 

NSIM WORK ARRAY 

/CWORK/All) 

RATIO 

” NSIM 

X 

NSIM WORK ARRAY 

/CMORK/ACNN) 

DWORK 

- NSIM 

X 

i 

WORK 

ARRAY 

/CW0RK/A(N1) 

lA 

- NSIM 

X 

i 

WORK 

ARRAY 

/CW0RK/A(N2> 

IB 

- NSIM 

X 

1 

WORK 

ARRAY 

/CW0RK/A(N3) 

IC 

- NSIM 

X 

1 

WORK 

ARRAY 

/CWDRK/AIN4) 

ID 

- NSIM X ; 

L WORK ARRAY 

/CWORK/A(N5) 

POLE 

- NSIM 

X 

1 

WORK 

ARRAY 

/GWORK/AIN6) 

EVR 

" NSIM 

X 

1 

WORK 

ARRAY 

/CWORK/ACN2) 

EVI 

- NSIM 

X 

1 

WORK 

ARRAY 

/CWORK/ACN3) 

XDOTO 

- NSIM 

X 

1 

WORK 

ARRAY 

/CW0RK/A(N1) 

POLES 

- NSIM 

X 

I 

WORK 

ARRAY 

/CWORK/A(N4> 


RETURN RI — RETURN TAKEN IF NOMINAL SYSTEM IS UNSTABLE 
DESIGNED BY; J-D. BURROUGHS JAN 1969 

REAL EVR { 1 ) 5 Etf 1 1 i ) , GMDSP Y1 1 ) , RH AU 20 ) , FREQ « 20 ) , XDOTO t i ) 

COMPLEX POLES t 11, POLECl) 

COMP LEX OMEGA » OMEGAl , 0MEGA2 , OMfc&AB , R 
DIMENSION IACT{10J,A(ll,RATIOil) 

DIMENSION DMORKCDrlAlliflBU) ,ICCl)ffID(l) 

REAL PARA (10) 

DATA iPOM/lOH-fr— t— E— W,IBLNK/10H / 

INDEXFlIi.,I2,Ml)=IH'(I2'-lJ#Hl 
IFdPOLE-GI.Ol GO TO 29 
C =====i==i FORM STABILITY MATRIX AND CALC. EIGENVALUES 
CALL STABMX(NSIM,XD0TQ,IC0UNT,RATI0,A,N,05 
CALL EGVL3C A, RATIO,EVR,EVI, IA,IBr IC, ID, DWORK, l.E-14,M, NJ 
DO 10 1=1, N 

10 pOLE{Il=CHPLX(EVRm,EVI{in 
HRITE(692i) 

21 F0RMAT|1H0/27X,20HNDMINAL SYSTEM POLES) 
c =====:;^=:^= CALC. NATURAL FREQUENCIES AMD DAMPING RATIOS 
CALL MATFRQl£VR,EVi,RATIO,DWORK,H,MPOLES) 

WRITEt6,2B67) N 

2867 FORMATl 2aX,I3,2X,*EI&ENVALUES*^/13X,*R£AL*p9X,^IHAGlNARY4, 

1 6X,4NATURAL FREQ.*,5X,4DAMP1HG RATI0«=1 

DO 2668 I=1,NP0LES 
J=IBLNK 

IFCEVIU>-GT«0.) J=IPOM 

2868 MRITE{6,ZS69)I,EVR(I) , J,EVIUS ,RATIOtI) ,0W0RK(I1 

2869 FaRHATl3X,I3,3X9GiZ.6,2X,A2,Gi2.6,4X,2&i6.6) 

IP0LE=2 

FMAX=0- 

C =^===-== DETERMINE MAXIMUM NATURAL FREQUENCY OF SYSTEM 
DO 2S I=I,N 
POMA G=CABS I POLE C 1 1) 
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IFIPQHA&-GT-.FHAX) FHAX=POHAG 
23 CONTINUE 

-==-=== SET FHAX - TWICE HAX» NAT, FREQ, OF MODEL 

£ THIS LIMITS RA«GE OF SEARCH FOR ZERO PHASEl 
FHAX=2«4=FMAX 

===i====== test for umstasle system 

DO 41 I=1,N 

1F(£VR{I).G£,Q,| GO TO 28 
41 CONTlMUc 
GO TO 29 

28 CONTINUE 
WRITE £6, 2?) 

27 FORMAT UHO,20X?40H*=<^*WARMlNG=M=4i NOMINAL SYSTEM IS UNSTABLE} 
RETURN R1 

====^== START STABILITY MARGIN ANALYSIS 

29 K-0 

=“===== ASSUME divergent WITH SH PARAMETER = 0 

30 I2ERO=0 

CALL VAROUTI lACHKJtP) 

GMDSPYl INOEXFSK B isKHAX ) ) -P 

= SKIP ANALYSIS FUR SH PARAMETERS WITH 0 NOMINAL VALUES 
IFtP«EQ»0-J SO TO 2010 
HRXTEC6»2011i PARAlK),P 

2011 FQRMAT£1H0/20Xb*N 0MINAL VALUE OF PARAMETER *eA8ff3H - ffG12<.6//| 
=-====== SAVE KOHIWAL VALUE OF SM PARAMETER 

GAIMO=P 

=====:==== SET SM PARAMETER = 0 
CALL VARHOD(IACT(K1bO-J 

======== CALC» STABILITY MATRIX AND EIGENVALUES 

GALL STABMXtNSIMtXDQTa»ICOUNT,RATIO»A*NsO) 

CALL EGVLBCAbRATIOtEVRbEVIbIAbIBbICbIObDWORKb l.E-l4,NpNI 
DO 165 I=1 bN 

165 POLES(IJ=CMPLX(£VR£l)B£ViaH 

======== CHECK SYSTEM STABILITY WITH SH PARAMETER = 0 

123 DO 170 I=LyN 

IFtEVRU) -GE.O.} GO TO 175 

170 CONTINUE 
WRITEC6,1711 PARACK) 

171 FORMAT (lH0*40X,=e^THE SYSTEM IS STABLE WITH =t=3A8*5H = 0- ) 
======= SET LOWER STABILITY BOUND = O AND FREQ = 1111 

tDEFAULT VALUE WHEN STABLE} 

GMDS PY CINDEXF C K 9 2» KHAX ) ) =0 • 

GHDSPYl INDEXF4Kf3,KMAX> J =1111- 
===-=== STABLE WITH SH PARAMETER = 0 
IZER0=1 
GD TO 180 

======= TEST FOR POLE ON IMAGINARY AXIS WHEN SM PARAMETER = 0 

75 IF{EVRai-GT-0}GQ TO 180 

=====“= POLE DM IMAGINARY AXIS WHEN SM PARAMETER = 0 

======= load SM PARAMETER VALUE AND FREQUENCY 

RMAG{1)=0. 

FREQCl)=EVI(Ii 
INDEX=i 

C ====== POLE ON IMAGINARY AXIS WITH SH PARAMETER =0 

IZERD=~i 

180 WRITEC 6*20301 PARASKJ 
2030 FQRMATC30X,*P0LES WITH *,A8,5H = 0-1 
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c ;===— :=:=s CALC- NATURAL FREQUENCIES AND DAMPING RATIOS 
CALL NATFRQ { EVR» EVI tRATI O f OHORK, N yNPOLES } 
WRITEt6f2867i N 

c =-=====. print eigenvalues with sh parameters “ 0 


DO 2870 I=X,NPaLES 
J-IBLNK 

IFCEVICI)»&T-Q- I J=IPOH 

2870 WRITEC6 52869)I,EVR{I) fJyEVICIJ fRATID UJ sDWDRKCl ) 

IFCIZERO-EO.-DGQ TO 2X0 

IWDEX-0 

0HE&A2=C0.,0* j 

C st=i==== evaluate TRANSFER FUNCTION MAGNITUDE AS<D PHASE AT 0 FREO- 

CALL TFSVAL ( OMESAR v POLES QL E »N* R f LFLAG , IQUAD2 y PHASE2J 
IFCREALSRU 210f200f200 
C ====== real DIVERGENCE INDICATED 

200 IND£X=1 

RMAGtLi=X-/CAaSCR> 

FREQil)=0, 

2X0 DMEGA={0.,-OX) 

OKEGA2=:OHEGA 

C ====== EVALUATE TRANSFER FUNCTION AT ^01 FREQ.^ 

CALL TFEVALC 0HEGA2, POLES *PDLE,Nif R,LFLA&,IQUAD29 PHASER} 

C SEARCH FOR PHASE ANGLE QUADRANT TRANSITION 

C GEOMETRIC SEARCH TECHNIQUE 

220 QH£GA==i-2*0HEGA 

C ======= tND SEARCH AT 24=MAX, NOMINAL NATURAL FREQ- 

IF{AIMAG(0MEGA) -GT.FHAXJ GO TO 400 
215 CONTINUE 

CALL TFEVAL(OM£GA,POLES,POLE,NfR,LFLAG,lQUAD, PHASE} 

IF { I ABS i IQUAD“IQUAD2)-2J 230 j 225 , 300 
C ====== CHANGED MORE THAN X QUADRANTs REDUCE STEP SIZE AND 

C CONTINUE GEOMETRIC SEARCH 

225 OMEGA- «9X667*0MEGA 
GO TO 215 

C ===it=== CONTINUE GEOMETRIC SEARCH 
230 PHASE2=PHASE 
□HEGA2=QMEGA 
IQUAD2=IQUAD 
GO TO 220 

C ======== ZERO CROSSING GCCURED, START DICHOTOMOUS SEARCH 

300 DMEGAX=OME&A 
PHASEX=PHASE 
IQUAD1=IQUAD 

G ========= DICHOTOMOUS SEARCH FOR ZERO PHASE 

DO 340 I=li,50 

QMEGA3=» 5^{ OMEGA 1+0MEGA2 } 

CALL TFE VAL £ DHEGA3 » PO LES ,POLE » N, R ? LFLAG , IQUAD3, PHAS E3 5 
C ======== test FDR CONVERGENCE 

IF(LFUG} 320,320f3i0 

C ===== convergence GCCURED, SAVE STABILITY MARGIN AND OSCILLATION 
C FREQUENCY 

310 INDEX==INQEX+1 

RMAG £ INDEX) =si ./CABS ( RJ 
FREQilNOEX J =AIMAG £ 0MEGA3 ) 

GO TO 230 

320 IF£IQUAD3 .EQ^IQUADIJ GO TO 330 
0HEGA2=0HEGA3 
GO TO 34Q 
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330 0MEGA1=D«EGA3 
IQUA01=IQUAD3 
340 CONTINUE 

WRITE£6»35lJ 

351 F0RNAT{lH0,47H^**VfARNlNG'i^=4' FAILED TO COJ«VERGE TO ZERO PHASE? 

GO TO 230 

C OUTPUT LEAST UPPER AND GREATEST LOWER GAIK LIMITS 

400 IF ( INDEX «£Q*0) GO TO 500 
GAMAX=1«E36 
GAMIff=“l .E36 
HAX-0 
HlN-0 
IMAX=Q 
IHXN=0 

C ==—===:= SCAN STABILITY MARGINS THAT WERE LDCATlED AND LEAST UPPER 
C BOUND AMD GREATEST LOWER BOUND, 

DO 450 I=lj INDEX 
XF{RMAGJI) •LT,1,? GO TO 430 
IFtRHAGC IJ«&T,&AHAXJ GO TO 450 
GAHAX=RMAGU? 

OHMAX=FREQ(I? 

MAX=1 
IHAX=1 
GO TO 450 

430 IFCRHAGC IJ-LT-GAMIN) GO TO 450 
GAMIN=RHAGiI) 

□HMIN=FREQ{ I) 

HIN=1 

IMIM-1 

450 CONTINUE 

IFCMAX.NE.U GO TO 405 
&AINL=GAMAX*GAIN0 

C ========= PRINT UPPER STABILITY MARGINS 

WRIT£{6,540) GA INLsGAMAXtOMMAX 
540 FDRHATUHOslOX»18HUPPER GAIN LIMIT =,Gll,4t 5Xs> 

1 28H(UPPER GAIN LIMIT ) /NOMINAL -fGil-4,5X, IIHFREQUEMCY =sGll»4, 

2 TH R,P»S.? 

c ========= load summary array 

GMDSPY{INDEXFtK,4tKMAX) ) =GAHAX 
GMDS PY ( INDEXF ( K y 5 9 KM AX ! J =OMMAX 
560 CONTINUE 
GO TO 407 

405 GHDS PY S INDEXF e K, 4, KHAXl) =1111. 

GHDSPYt INDEXF1K»5,KMAX i 
WRITE{6,4061 

406 FORMAT UHO,10X9=4=NO UPPER LIMIT WAS L0CATED=J=1 

407 IFtMIM-t4E-l) GO TO 470 
GAINL=GAHIN*GAINO 

C ====== print lower STABILITY MARGINS 

WRITE t6,410) GAINLyGAHINyOHMIW 
410 FORMAT SlHOylOXtlSH LOWER GAIN LIMIT =9G11.4» 5X* 

1 28HCL0WER GAIN LIMIT 1/NQMINAL =* G1I.4»5X9 IIHFREQUENCY =9Gllo4y 

2 7H R.P.S.) 

c ======== load summary array 

GHDSPy ( IND^ ^F { K 9 2, KMAX I i =GAHIN 
GMDSPYaNDEXF(K»3»KMAX J ) -OHMIN 
GD TO 475 

470 IFUZERO.EQ.l) GO TO 475 


BCS 40262-2 


103 



GMDSPYtIND£XFlK,2,KMAXn-im» 

GMDS PY UNDE XF I Ks 3, KMAK } } =1U 1 • 

WRIT £{6,473} 

473 FORMAT tlHO,iOXs>6'NQ LOWER LIMIT WAS LOCATED*} 

475 IF{MIN+MAX.EQ.IMD£X) GO TO 600 
c =:==:=ss:==:s^= LIST OTHER S«0?lCRlTiCAL STABILITY LIMITS 
WRITE{6t481) 

481 FDRKATUH0,30X,29HOTHER NOMCRITICAL GAIN LIMITS} 

DO 485 I=i,lNDEX 

IFU i,ED«IMAX}.OR.CI.EQ.IHIN}} GO TO 485 
WRITE{6,484J RMAGlI),FRtQU} 

484 F0RHATt]tHa,2QX,2ZH(GAiJ« UHIT}/NOHINAL =,G11.4,5X, 

1 liHFREQUENCY ^,G11*4) 

485 CONTiWiUE 
GO TO 600 

500 WaiTE{6,5011 

501 FORHATtlHOslOXf^ND LIMITS WERE LOCATED*) 

J=2 

IFUZERO.EQ.IJ J=4 
DO 502 I-J, 5 

502 6MDSPYliNDEXFlK9l»RMAX})-llll, 

600 CONTINUE 

C =^======== RESTORE S^^ PARAMETER TO NOMINAL VALUE 

CALL VARMODUACTIKisGAlHO) 

C test if all SM PARAMETERS HAVE BEEN EVALUATED- 

2000 IF(K.LT-KHAX) GO TO 30 
RETURN 

2010 DO 2020 J=2,5 

2020 GMDSPY{IND£XFtKtJ,KHAXJ)=0, 

GO TO 20t0 
END 
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CGF8TCH 

OVERLAY! GF8TCH»3fO) 

PROGRAM GFBTCH 

C VERSION 3. REVISEDS APRIL 30 1976 

COMM DM /CP/P { 1 ) /CX/X I U/CXDOT/XDOT C X S/CXIC/XI C! i J 
COHMDM/CORDER/NSIHtNDV®NQP/COVRLY/lMST»LGKSSsLDKSIM 
CQHMCM/CPP.fi?l/DEPEN,INDEPlrINDEP2,DUMl( 5) 
C0MMCfS/CPRQy/XHIffil,XMAXl,XHIN2,DELTA2,CURVES,DUM2tl5I 
COMMOI^ /CWaRK/GDSPLVI50»2sX0i/ERHESS/IFATAL,lERR 
C'JHMOM/CNTRLS/ANTYPE, IPRIMjlMQDE, ERROR ( 11 
COMMON/CI IME/7IME 

COMMON /CPLOTS/ iNQPLT,lNDMR9lQPTt301,PLOTI01 5UPTITLEI 6)® 
+ IPOPTCIOJ 

REAL XOPTUJ 

EQUIVALENCE EXOPTC I) t lOPTU) ) 

REAL D£P£N*IN0£P1,1NDEP2 
TIHE=0. 

DATA IBLNK /lOH / 

IF(IWST-EQ»13)&0 TO 4050 

CALL CODGEN ( XNDEP2 ,0, IN02 J ® RETURNS C 4000 1 

ICUR=IFIXf CURVES I 

2000 CALL C00b£Nl0£PEN*0jlD£PEN)»RETURNSC4020) 

CALL CODGEN C INDfcPl® 0, INDiJ , RETURNS (4040 1 
CALL VARDUT(INQ2sXDUH2) 

IF(ICUR.LT.i) ICUR=1 

IFtiCOR-GT-iOl ICUR=10 

YHINI-X«£36 

YMAXI='"i-E36 

CALL VAR0UT(IND1,XDUM1 

NPTS=50 

DELTA=(XMAX1-XMIN1 1/49. 

DO 2135 
XDQTCl)=Oo 
2135 X(1J=XIC(I) 

I0PT(3) = IBLNK 
IGPTt4) = IBLNK 
CALL OTTIM £I0PT(31) 

ISET^i 

Q -rURM DM ERROR MESSAGES IN MODEL 

IERR=1 

CALL EQHQtTlME ,TiME jISETJ 
XDUM 1=XM 1N2-DELTA2 
IF(ICUR-GT»11 GO TO 2130 

HRITE(6,2i3UDEPEN®INDEPI,PTlTL£®IQPT( 3J9IQPK4) 

2131 FORMAT £40Xs46H /*/*/’>=/ GENERAL FUNCTION ANALYSIS /^/^s^/*/ 

1//55X,AS®4HVS ®A8//26X,8AI0//54X»2AI2/1 

GO TO 2137 

2130 NRIT£(6?2134) 0EPEN®IN!DEP1,INDEP2®PTITL£» I0PT(3J ,IQPT(4) 

2134 FORMAT (40Xs46H GENERAL FUNCTICW ANALYSIS /^/^/^/ 

i//50X,A&,4HVS rAS,2H+ »A6 //26X® 6A10//54X»2A12/) 

2137 DO 2139 J=i,ICUR 

XDUH l=XDUHl-i-0ELTA2 

IF(ICUR,&T.llWRlTEC6,2l32)J,INDEP2sXDUHl 

2132 FORHATCH^O CURVE N0.^»I3i,4X,Aa»3H = ,G12-5) 

IF£ICUR.GT»1) CALL SETIN ClND2sXDUMll 
X0PT(J+i5) = XDUMi 

DO 2133 1-1®NPTS 

GDS PLY ( I » 2j J i =XMIN1+ 1 1-1 1’^^OELIA 
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CALL StTINCIMDi.GDSPLYlIjZsJ)) 

CALL VAROUTtIDEPEM,GOSPLYn,iffjn 
lF(GDSPLYEItl*J>-GT.YMAXIJ Y^^AXI=GDSPLV^ 1,1., J} 
IF(GDSPLY{I,1,J}»LT.YMIMI} YMIf«I=GDSPLY£I,i,J} 

2133 CONTINUE 

WRITEC6,2I3fi) {IHDEPI, (GDSPLYU+CK-lLl+lO, 

1 2,J >,1-1,10) ,D£P£N,£G0SPLYlI-i-{iC“i}*10,l,J), 1=1, 10), 

2 K=l,53 

213S FORHATglH ,A8,1H:,10G12.5) 

2139 CONTINUE 

r 

SET PLOT PARAMETERS 


3300 


4000 

4001 


4020 


4040 


IF t INOPLT -Ey. 0 1 GO TO 3500 

IGPTCU = 1 

10PTt2J = IDPTI2) + 1 

X0PTC5) = DEPEN 

XOPTCd) = INDEPl 

XDPTt?) = INDEP2 

DO 3100 1=3,13 

IQPTU) = 0 

I0PTII4) = NPTS 

10PTS15) = ICUR 

WRITE 130) IQPT,PL0TID,PTITL£ 

WRITE (30) Ct CG0SPLYtI,J,K>sI=i,NPTS),J=l,2)'^}t=l,ICUR) 

INDWR = 1 

CONTINUE 

CALL VARHODtlNDlsXOUMJ 
IFCICUR-LE.l) GO TO 2150 
CALL VARH0DCIND2,XDUM2J 
WRIT£i6s215U 
FORMAT (/////) 

GO TO 6000 

WRlT£t6,4O0i) 1MDEP2 

FORMAT (//10X,31H={^=^ WARNING CAN*T 1 DENTIFY, IX, AlO , IX, 

1 25HAS A VALID SCAN PARAMETER//! 

CALL COD&ENtOEPEN,0,IDEP£N),RETURNSt4020) 

CALL COD GEN £ INDEP 1 , 0 , INO 1 J , RETURNS C 4040 > 

WRITE£6,2131) 

GO TO 6000 
WRITE£6,400i) D£PEN 
GO TO 4010 

WRITt£6,4001) INDEPl 
WRITE£6,2151) 

GO TO 6000 
1CUR=1 
GO TO 2000 
CONTINUE 

TURN OFF ERROR MESSAGES IN MODEL 

IERR=0 

END 
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CINIT 


OV£RLAY( INIT,1,0) 

PROGRAM I MIT 

C VERSION i.2 R&VISEDS MAY 15 1975 

C PURPOSE; TO INITIALIZE INTEGRATOR CONTROL,? ARAMETER NAMEjSTATE 
C NAME, RATE NAME, VARIABLE NAME ARRAYS TO DEFAULT VALUES 

C DESIGNED BY; J*D, BURROUGHS FEB 197A 

COMMON /CORD ER/NDX , NO V , NOP/CINT/ INT C 1 1 

COMHON/CNAMEX/NAH£X(i)/CNAM£R/NAM£RU>/CNAMEV/«AHEVtI)/CNAMEP/ 
1 NAMEPU)/CXIC/XiCCl) 

COHMOf^CNTRLS/ANTYPE, I PRINT, MODE, ERROR! 1} 

COMM ON/C WORKN/NN ( 7 ) 

REAL NAMEX,NAMER,NAMEVsNAM£P 
C INITIALIZE INT ARRAY 
DO 10 I=1,N0X 
ERRQR{IJ==.l 
XlCU]“£t. 

10 INT{I)=i 

C LOAD STATE NAME ARRAY WITH S001,SQ02,» 

C CALL COOLOD!MAHEX,NOX,iHSi 
C LOAD RATE NAME ARRAY WITH ROOl, R002 , . 

CALL CDDL00$NAMER,N0X,1HR) 

LOAD PARAMETER NAME ARRAY WITH P001,P002s.«. 

CALL CQOLODJi«AMEP,MOP,lHP) 

LOAD VARABLE NAME ARRAY WITH V00i,V002, » • * 

CALL CODlQD ! NAME Vt NOV, IHVJ 
CALCULATE INDICES FDR WORK STORAGE 
NN=sNOX*NOX-i-l 
ipat 1) =NN•^NQX=^=NDX 
IF(N(i)»LT-l68JNSl)=168 
DO 100 X=2,7 
100 NCI)=N(I-1J+N0X 
CALL PLINIT 
END 
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•. I 

i 

CIMPUTS 

SUBROUTINE INPUTS{ A 9 N 9 K 9 NHAX) 

VERSION 1- REVISED: HAY 22 1975 

PURPOSES ALLOW FREE FIELD INPUT DF ARRAY DATA 
CALL SEQUENCES A - ARRAY TO RECEIVE DATA 

IS - NUMBER OF ROWS IH ARRAY 

H “ NUMBER OF COLUMNS IN ARRAY 

NMAX - ROW DlMENSIOKf OF ARRAY A 
METHODS THE FOLLOWING COMMANDS ARE RECOGNIZED 
Z = ZERO ALL ELEMENTS OF ARRAY 

1 = SET ALL ELEMEf^TS OF ARRAY TO 1.E3B {INFII4ITY1 

C = INPUT DATA TO BE GIVEN BY COLUMN 

R = INPUT DATA TO BE GIVEN BY ROW 

D = INPUT DATA TO BE GIVEN BY DIAGONAL i 

FOLLOWING THE COL, ROW, DIAG, COMMANDS THE ROW AND COLUMN LOCATION ! 

AT WHICH DATA LOADING IS TO START MUST BE GIVENu THESE VALUES 
ARE FOLLOWED BY ELEMENT VALUES. EACH COMMAND, ROM NO., CDL. 

DR ELEMENT VALUE MUST BE SEPERATED BY ONE OF THE STANDARD DELiHITE | 
STANDARD DELIMITERS ARES THREE OR MORE SPACES? COMMA? EQUAL SIGN? i 
LEFT OR RIGHT PARENTHESIS. 

DESIGNED BYs J.D. BURROUGHS HAY 1975 

COMMON/CCOMM/ICOM 1 8 ) , I PHRS 9 INDEX 
DIMENSION ICOMLC5J,A(l J 

DATA IC0ML/50HZ I C R D / 

> SET DEFAULT MODE TO COLUMN INPUT 

MODE =3 

-=L==:==^ mode = MODE OF INPUT INDICATOR. 1 = ZERO ARRAY 

2 - SET ARRAY TO 1-E369 3 = COLUMN INPUT, A = ROW INPUT, 

5 = DIAGONAL INPUT. 

I=:l 
J ~1 

1STAT==2 

===:==^= ISTAT = INPUT STATUS INDICATOR- 0 = ROW NO- NEEDED; 1 = COL 

2 = READY FOR DATA VALUES 

100 INDEXS^IWDEX 

C > LOCATE NEXT PHRASE 

CALL NXTPHtlCOMBlMDEXjIPHRSJ 
IFdPHRS.NE.IOH >G0 TO 200 

C > READ NEXT CARD 

READt59l2ilIC0M 
IFCEDFiSn 520,140 
121 FORMATtSAlO) 

140 WRlTEt6al4i)ICDM 

141 FORMAT t/20H COMMAND CARO >,5X,8A10) 

INDEX=L 
GO TO 100 

C TEST FDR NUMERIC PHRASE 

200 CALL NUHERC { I PHRS), RETURNS (3001 

C NUMERIC PHRASE DETECTED 

CALL BCDRELt VALUE, IPHRSJ 
IFMSTAT"!) 210,220 ,240 
210 i=VALUE 
ISTAT=1 
GO TO 100 
220 J -VALUE 

ISTAT=2 
GO TO 100 

C — ■“> TESTS TO LIMIT IMPUT TO GIVEtH ROW AND COLUMN DIMENSIONS 


108 


BCS 40262-2 


240 


IF(I-GT.N-0R,J-GT-.M)&0 TO 100 
K=I+NMAX*(J-I) 

ACK)=VALUE 

C -> INCREASE INDICES DEPENDING 0?S INPUT MODE 

IF(M0DE-'4J280,260,270 
260 4-J+l 

GO TO 100 
270 J-J+X 
280 1=1+1 

GQ TQ 100 

C > ALPHA PHRASE DETECTED 

500 GALL LCMPHaPHRS,IC0MLv5rl»M0DEJ 
IF{HODE-EQ-01&0 TO 500 

C — > RESTORE INDEX TO PREVIOUS PHRASE SINCE ALPHA PHRASE IS NOT R 

IFIHQDE-2)340,3SO,310 
310 ISTAT=0 

GD TO 100 

C ZERO ARRAY MODE 

340 NH=NMAX*M 

DO 360 1=1 rNH 
360 Ail)=0- 

GO TO 100 

C SET ARRAY TO 1.E36 (INFINITY) 

3 SO NM=NMAX+H 

DO 400 I=1,NM 
400 AM)=1-E36 

GO TO 100 

500 IND£X=IND£XS 
520 RETURN 
END 
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CI^iTERP 

OVERLAY t IMIERP , 2, & ) 

PR06.KAM INTERP 

VERSION 4, REVISEDS JULY 6 X977 

PURPOSE 5 

READSiPRINTS AND INTERPRETS INSTRUCTIONS FROM DATA CARDS 
CALL SEQUENCES 

IREAD - READ UNIT NUMBER 
INST ~ IltSSTRUCTION NUMBER 

DESIGNED BY s J.D. BURROUGHS FEB 1974 

DIMENSION AINTU) 

COMMON /CNITRLS/INSTD , IP RiNTilMDDE, ERROR { U 

COMMON /COVRLY/INSTsLDKSSfLOKSIMsCPUSEC/CIO/IREADflWRITEjIDIAG 
COMM DN/CXiC/XIC { 1 ) /CWORK/WORR C 1) /CP/P 1 1 > /C INT/IN T { 1 J /CX/X C 1 J 
COMMIT /CXIC I/XiC I{ I |/CXICE/XIC2a J/CXICi/XICS ( I ) 
COMMON/CNAHEX/NAMEXl i)/CNAHER/NAH£Rt 1 J/CNAHEV/NAMEV C il/CNAMEP/ 

1 NAHEPCll 

COMHDN/CUNI 7X/MUN1TX I i J/CUN ITR/NUN ITR ( i >/CUNI TV/NUNITV { 1 ) /CUN IIP/ 

1 NUNITPCI) 

CQMM0W/CSCALE/SCAL£(554,6> ,NVARC5,2,6) ,NPLTS( 6 ) 

COMMON /CSMPAR/SHPAR110lsICINDi2J 
COMM ON/CDRDER/NOX,NOV,NOP/CTIHE/ TIME 
COMMON/CPRINT/PRTNAMfiO) ,LPRTtIO| 

COMM ON /CPR DN/PRONAH ( 8 ) /CPROV/PV ALUE 1 27 ) 

COMMON /CPLDTS/ iNDPLTsINDWRjIOPTCSO J ,PLOTID{ 5J,PTITL£( 8 J , 

+ IPOPKiO) 

CDHM0N/CC0MM/IC0MC6 ) 9 I PHRS? INDEX 

CDHMDN/COLOIH/NXyNU,NS9NC9NRSfNRCrIXOC,IUOCjIOCANffIPOINTC25) 
COHHON/CT ABNA/TABN AM C I ) /CMAXD I/NDT AB 9 MAXDIM i 1 } /CLDCTA/LQCTAB 1 1 ) 
COMMCM/C TABLE/TABLES { X) 

REAL IPHRS»ICOML559) sNAM£XsNAMER,NAMEVbNAMEP,NUNITX,NUN1TR, 

1 NUNITV,NU41TP 

REAL NVAR , IBLNK, I PROSN I & i » PRON AM » IPROGVl 27 1 jS MPAR ? IC 

EQUIVALENCE UINT 9 IWT) 

DATA iCLHAX/59/5N0N£/10HNQNE / 

DATA IPNMAX/8/,IPVMAX/27/ 

c =============^== program commands 

DATA ICOHL /590HDEFIME STADEFINE RATDEFIN 6 PARDEFINE VARINITIAL CO 
XPARAHETER DiSPLAYl DISPLAY2 DISPLAYS DISPLAY4 DISPLAYS DISPLA 
2Y6 SCAMl SLAN2 XIC-X XIC-XICl XIC-XIC2 XIC-XIC3 XI 

3C1-XIC XIC2-XIC XIC3-XIC ALL STATESNO STATES INT CONTROERROR CO 
4NTSIHULATE LINEAR AMAEIGEN SENSSTABILITY TRANSFER FSTEADY STAROOT 
5 LOCUSPUNCH X SM PARAMETPLQT TABLEPRIMT VARITITLE PLOT ID 

6 PLQT ON PLOT OFF SC4Q20 CALCOMP RL MANUAL RL AUTO SCSI MAN 

7UAL SI AUTO SCSS MANUAL SS AUTO SCTF MANUAL TF AUTO SCBODE NI 

8 CHQLS NYQUIST PRINTER REDESIGN O.CO.C. DATA SAVE Q«C«. PLOT ALL 
9 TTABLE / 

DATA IBLMK/IOH /fIC/lOHIC / 

C program names ===-===== 

DATA IPROGN/80HDEPEN INDEPl XN0EP2 EIGEN PARATF INPUT T 

IF OUTPUT SS PARAMETRL PARAHET/ 

c ===========^==-=:s: program values =====-================ 

DATA IPROGV/270HSTARTX STOP! START2 DELTA2 CURVES2 

IPRINT COWTPRATE OUTRATE INT MODE TINC TMAX FREQ M 

2AX FREQ MIN SS START SS STOP SS POINTS SS ITERATIRL START RL 
3 STOP RL POIN1S REAL MIM REAL MAX IMAG MIN IMAG MAX O-C- MOD 
4bLQ-C, ORDERINITIAL TI/ 

C TEST FOR CPU SECOND MEASURE 
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IF£CPUS£C,EQ*0.)G0 TO SO 
CALL SECOND £CPS£C) 

CPDEL==CPSEC~CPUS&C 

WRITE{6,7I)CPD&L 

71 F0RMAT(/10X,G13.6t* CPU SECONDS WERE REQUIRED FDR THE PREVIOUS ANA 

1LYSIS=*=/) 

8Q NAMPRT^IMST 

XM0D£=PVALU£{9) 

90 INST0=0 

IFtINDEX,GT-0-AHD.lNDEX-LT»aiJGO TO 120 
READ AND WRITE ONE CARD 
100 READ CIREAD, 101) ICOM 
IFCECFCS)} 5000,111 
101 FDRMATCSAIO) 

111 WRITE{fa,105j ICOM 

105 F0RHAT(/20H COMMAND CARO >,5X,SA10J 

C- ->SET CHARACTER SCAN INDEX 

INDEX^l 

C >LQCATE NEXT PHRASE 

120 CALL NXTPH£IC0H,1NDEX*IPHRS) 

C— >READ NEXT CARD IF BLANK PHRASE 

140 IFtIPHRS.EQ-IBLNK) GO TO 100 

C >SEARCH COMMAND LIST 

CALL LCHPH 1 1 PHRS , ICOHL , ICLHAX , i, INST ) 

C >CDHHAND IDENTIFIED 

IFtlNST-LEoO) GO TO 160 

BRANCH TO NEW COMMAND ========== 

GO TO (200,200,200,200*200,200,210,220,230,232, 

1 234,236,500,500,240,250,260,270,280,290, 

2 300,310,320,200,200,500,500,500,500,500, 

3 500,500, 920,330,200,360, 550, 560,570, 580, 

4 590,600,610*620,630,640,650,660,670,680, 

5 690, 700, 710,720, 820»&00,900, 960, 980) , ,INST 

0=========== SEARCH PROGRAM NAME LIST ========== 

160 CALL LCHPH(iPHRS,rPRDGN!rIPNMA-X,l,iNST) 

C >PHASE NOT PROGRAM NAME 

IFdNST.LE.O) GO TO 170 

C >GET NEXT PHRASE 

CALL NX! PHI ICOM, INDEX, IPHRSJ - ' ' ' 

C ^>LDAO PROGRAM NAME 

PRQN AM I INST) =IPHRS 

iFUNST,NE-7-AND-lNST«N£«.S) GO TO 165 
IF { I PHRS, EQ .NONE) PRONA M CiNSt 1 “IB LNK 
C-“ — “>G£T NEXT PHRASE 

CALL NXTPH( ICOM, INDEX, IP HRS) 

IClND(INST-6)=0 
IF8IPHRS-NE-iCJ GO TO 168 

INOICATER .EQ. 1 

ICIND{INST“6)=1 
165 INST 0=0 
GO TO 120 
168 INST0=0 
GO TO 140 

C=-^=== SEARCH PROGRAM VALUE LIST ========= 

170 CALL LCHPH(IPHRStIPR0GV,IPVMAX,1,INST) 

C— >PHRASE NOT PROGRAM VALUE 
IF(INST.LE.O) GO TO 178 
C — — “>GET NEXT PHRASE 
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CALL NXTPHtICDM, INDEX, IPHRS} 

C— >lcST 1ST CHARACTER FOR NUMERIC 

CALL NUMERC 1 1 PHRS > » R ETURNS 1 176 ) 

C >CQNVERJ A TO G pQRKAT 

CALL BC0REL(PVALU£(IWST1,IPHRS> 

GD TO 165 

176 WRITE£6,177) IPROGVCINSTJ ,IPHRS 

177 FORHAT(//iOX,I5H^^ WARMING «*^,3XvA10,22HCAK*T BE SET EQUAL TQ: 

1 A10,23H VALUE MUST BE NUMERIC //) 

GD TO 168 

C >CH£CK FOR OUTSTANDING COMMAND 

178 IFtINSTO.LE.O) GD TO 180 

C-=r^i==:= branch to outstanding command ==^==::;==- 
GO TO (410,4.20,430, 440,450, 460,4S0,480j»480,4&0, 

1 480,480,500,500,240,250,260,270,280,290, 

2 300,310,320,520,530,500,500,500,500,500, 

3 5 00 , 5 00 , 5a0 , 540 , 940 , 545 ,550,560, 500 , 500 , 

4 500,500,500,500,500,500,500,500,500,500, 

5 500,500,500,500,500,800,800,960,980) ,INSTO 

180 WRIT£{6,i8UIPHRS 

161 FQRMATt//15X,34H=i^* WARNING CAN=J=T INTERPRET ,A10//) 

GO TO 120 

C >SET INSTO TO INDICATE A NEW OUTSTANDING TASK 

200 INST □= INST 

HODE^l 
GO TD 120 
210 I0SPLY=1 
215 NPLTS{IDSPLV)=0 
GO TO 20G 
220 I0SPcY=2 
GO TO 215 
230 IDSPLY=3 
GO TO 215 
232 IDSPLY = 4 
GO TO 215 
234 lOSPLY = 5 
GO TD 215 
236 IDSPLY = 6 
GO TQ 215 

C >TRANSFER X TO XIC 

240 CALL XFRIX,XIC,NOXJ 
LQKSIM^LOKSS 

245 WRIT £(6,2630HI,NAMEX( I) ,XIC 1 1 ) , I=1,N0X) 

2630 FaRMAT(lHl,40X,7H/*/=*‘/^/,3X,=5^INI7IAL CONDITIONS/OPERATING POINT=s^ 

1 3X,7H/*/=i=/^/,//5(I4,lH ,A8,3H = ,Gi0.4)l 
WRITE(6,247) 

247 FORMAT!/////) 

GO TO 165 

C TRANSFER XICl TO XIC =====:===:^ 

250 CALL XFRtXICi,XIC,NQX) 

GO TO 245 

C =====:^==== TRANSFER XIC2 TO XIC =====.=-=:=:- 
260 CALL XFRCX1C2,XIC,N0X) 

GD TO 245 

c TRANSFER XIC3 TO XIC 

270 CALL XFR£X1C3,XIC,N0X) 

GO TO 245 

c TRANSFER XIC TO XICl ========== 
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280 CALL XFRCXIC,XIC1,W0X> 

GO TO 165 

c ===^=:^=t:stss transfer XIC to XIC2 ========== 

290 CALL XFR(XIC,XIC2»N0X) 

GO TO 165 

C ========^= TRANSFER XIC TO XIC3 ========== 

300 CALL XFR{X1C,XIC3,NDX) 

GO TO 165 

C ========== all STATES ========== 

310 DO 315 I=i,NOX 
315 INT(IJ=1 
GO TO 165 

C ======:=== j^Q STATES ========== 

320 DO 325 I=ltNOX 
325 INTtD^O 
GO TO 165 

C >LDAD SHPAR WITH BLANKS 

330 DO 335 1 = 1,10 
335 5HPARII}=I8LNK 

338 INSTO=INST 
ITN0=1 
3A0 M0D£=0 

GO TO 120 

C LOAD PRTNAM WITH BLANKS 

360 DO 365 1=1,10 
LPR1CIJ=-1 

365 PRTNAMU )=IBLNK 
GO TO 338 

C ”>DEFINE STATES TASK 

410 CALL KAHESI IPHRS,MAHEX,NUfiITX,MQX9lTN0,MQDEJ 
GO TO 120 

C >DEFINE RATES TASK 

420 CALL WAMES£IPHRS,NAMER,NUNITRrNQX,JTMO, MODES 
GO TO 120 

C >DEFINE PARAMETERS TASK 

430 CALL WAHESiIPHRS,MAMEP,NUWITP, NOP, ITNO, MODE) 

GO TO 120 

C >DEFINE VARIABLES TASK 

440 CALL NAHES£ I PHRS, NAME VpftHJNlTV,?iOV,ITNO, MODES 
GD TO 120 

C MNITIAL CONDITIONS TASK 

450 CALL VALUES UPHRSyNAMEXsMDX, XIC, ITMD, MODE) 

GO TO 120 

C ^>PARAMET£R INPUT TASK 

460 CALL VALUES< lPHRS,NAMEP,NOPsP, ITND, MODES 
GO TO 120 

C >DISPLAY TASK 

48Q CALL DISPLA(1DSPLY,IPHRS,M0D£,IC0L) 

GO TO 120 

C-^ >RETURN TO MAIN PROGRAM WITH INST SET TO INDICATED TASK 

500 INSTD=0 

IF{NAHPRT-EQ-1)&D TO 5005 
GO TO 6000 

C >LOAD INTEGRATOR CONTROLS 

520 CALL VALU£SUPHRS,NAHEX,N0X,A1NT,ITND,M0DEI 

C — >CONV£RT REAL TO INTEGER 

IFCHODE-EQ.O) INTt ITND )=AlNTt ITNO) 

GO TO 120 
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C ^>LOAD ERROR CDWTROLS 

530 CALL VALUES £ I PHRSjWAHEXyNDX?eRRORyIT?|0, MODE} 

SO TO 120 

C-r-^>LOAD STABILITY HARGIM PARAMETER MAME 

540 CALL MAMESlIPHRSTSMPAR»NUMIT*XOfITNO,MQD£} 

542 1TW0=ITM0+1 

GO TO 340 

C — LOAO PRINT VARIABLE NAMES 

545 CALL NAMESC IPHRS.PRTNAMfWUMITylOpITNQsMODEl 

DETERMINE I«D» CODES FOR PRINT QUANTITIES 

IFCMDDE-NE.DGQ TO 542 

CALL CDDGEM{PRTWAM{ITNG) ,03LPRTMTfJ0i)»RETURNS£546J 
GO TO 542 

546 WRIT£{6s547iPRTNAMEITNQi 

547 F0RMAT£//20X,31H«^4* WARMING CAN T lDENTIFY3 3Xf AiO 

is*AS A VALID PRINT VARIABLE*//) 

GO TO 542 

C 

C SET PLOTTING OPTIONS 

C 

C ====:==:==^== TITLE = ===1==^==:=== = = 

550 CALL TITLE ( ICOH, INDEX ,PTITL£, SO ) 

GO TO 562 

C PLOT ID =-= = =^===:s==x= 

560 CALL TITLE C ICON , I«fDEX,P LOTI 0, 48 ) 

562 iMD£X-0 
GOTO 90 

C =-:==^=t^=i=^ plot on ==-:======== 

570 INDPLT = I 
CALL ONSWU) 

GO TO 165 

c ========- plot off ========== 

580 INDPLT - 0 
GO TO 165 

C ========== SC4020 ========= 

590 I0PTt29) = 0 
GO TO 165 

C ========== CALCDHP ============= 

600 IDPTC29) =1 
GO TO 165 

C =========== RL MANUAL SCALES ========== 

610 IPQPTU) =1 
GO TO 165 

C ========= RL AUTO SCALES ======== 

620 IPQPTUS =0 
GO TO 165 

C ============ SI MANUAL SCALES =========== 

630 IP0PTt2) =1 
GO TO 165 

C =====;=== SI AUTO SCALES ========= 

640 IPOPTC2I =0 
GO TO 165 

C ========== SS MANUAL SCALES ========= 

650 IP0PT£3) = i 
GO TO 165 

C ======= SS AUTO SCALES ======== 

o60 IP0PTS31 = 0 
GO TO 165 
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c =======:= tF manual scales ==:====s==i= 

670 IPQPTC4) = 1 
GO TD 165 

C s==*=^= TF AUTO SCALES 
680 IPDPTC4I = 0 
GO TO 165 

C EsDDE =====sr=== 

690 IPOPTiS) =1 
IP0PT{6)=0 
IP0PT(71-0 
GO TO 165 

C :======;=s.= NICHOLS ========== 

700 IPDPT{7) =1 
IP0PTE6>=G 
IP0PT£5)-O 
GO TO 165 

c ^======== t^YQUIST ======= 

710 IP0PTt61 =1 
IP0PT£75=O 
IPQPTt5J=0 
GO TO 165 

C ========== PRINTER PLOTS ========== 

720 IQPT130} =1 
CALL DNSW12) 

xndplt=i 

GO TO 165 

c ^ — read 0-c. data task 

SOO CALL OCDATA 
GO TO 165 

C =========== DESIGN D.C« TASK ============= 

Q — y£S-j- ypxAT MODEL IS DIMENSIONED FOR D«C. DESIGN 

820 IF£I0CAN«EQ^2)G0 TO 500 
WRITEt6,825) 

825 FORMAT (//15X»iSH=i^** WARJ4ING »S=***3X»^MQRK SPACE WAS NOT PROVIDED IN 
1 MODEL FOR OPTIMAL CONTROLLER DESIGN=4^//S 
GO TO 165 

C ============== SAVE 0«C. TASK ============ 

900 CALL OCSAVE 
GO TO 165 

C ============= PUNCH X TASK ================ 

920 WftITE£3,92lJ 

921 FORMAT t^INITIAL CONDITIONS^) 

WRITE{3ff922) tNAMEXU)»XtI) »I=1»N0X) 

922 F0RMAT(4£A7j*=*7&10.A-,’S‘»*) ) 

GO TO 165 

C ============== PLOT TABLES TASK =========== 

940 CALL LCHPHiIPHRS,TABNAH7N0TAB»l,NTAB) 

IFtNTAB.LE-OiGO TO 950 

C— •' CALL TABLE PLOTTING ROUTINE 

945 CALL PLOTABtNTAB) 

CALL QNSW(I) 

GO TO 120 

950 WRiT££6y951JIPHRS 

951 FQRHATt//15X,X5H=«'** WARNING ^4^*, 3X,A10 p * IS NOT VALID TABLE NAME’S^ 


1 //) 

GO TO 120 

c ============== plot all tables task ============= 

960 NTAa=“l 

BCS 40262-2 il5 


GO TQ 945 

c ======:==:=:==:== TABLE TASK =====s=:“==;=====^ 

9S0 BACKSPACE IREAD 

CALL TAB im TABLES, TABMAM,HAXDIH»LOCTAB,fiQTABJ 

INDEX-0 

GO TQ 90 

C-— — >END OF FILE ENCOUNTERED 
5000 INST=-1 

5005 WRITE(6,5010HI,NAH£XCIS ,i=i,NOX) 

5010 F0RHATC//1H1,50X,11HSTATE NAMES//10tI4,lX»AB'iI 
WRITE(6,5020> [I,NAMERU5 ,1-lyNOXS 
5020 FORHATt//5QX,iOHRATE NAM£S//iO(X4,lX, A8J ) 

WRITE 1 6 , 5030 HI ,NA«EV 1 1 1 »I= 1 , NQV I 
5030 F0RHAT(//30X,14HVARIABLE MAKES// 10 Cl 4, IX, ASH 
WRIT£C6,5050) UsNAMEPC II ,P{IJ,X=I,N0P) 

5050 FORMAT 1//49X, PARAMETER VALUES V/5U4, IX, AS, 

12H= ,&I1.5>) 

c :====^====== SCAN FOR UNINITIALI2ED PARAMETERS 

J=0 

DO 5100 1=1, NOP 
IFCPCIKNE.-99999JG0 TO 5100 
J=J-M 

WORK {Jl=NAH£P III 

5100 continue 

IFCJ-GTo0)WRlTEC6,5101)fW0RK(I),I=l,al 

5101 format t//W15X,15H=5=’5‘=f= WARNING =4^>>==4^,15X,’J'UNINITIALIZED PARAMETERS=^= 
1 //I0S3X,A8,2X) T 

6000 CONTINUE 
TIME=PVALUE{27J 
WRITE(6,6001) 

6001 FDRMATClHil 

Q g£j CURRENT CPU TIME 

CALL SECOi^DiCPUSECJ 
END 
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CLABTC 

OVER LAYILABTCH r 5 r 0 ) 

PROGRAM LABTC 

C PURPOSES PROVIDE OVERLAY INTERFACE TO PASS WORK STORAGE 
C APvRAYS TO LINEAR ANALYSIS ROUTINES LABTCH AND ESQTCH- 

C DESIGNED BV= J-D^ BURROUGHS FEB 1974 

C VERSION 1- REVlSEDs JUNE 9 19T5 

CONMON/CORDcR/NSIM ,NDV»NOP 
CDMMC!N/CPR0N/DUHU3),ESPARTDUH2t4] 

COMM DN/CO VRLY/I NST » LOK 5S , LOKSIH 
COMMON/CWORK/AU) 

COMMON /CW0RKN/NN»NitN2TN3,N4rN5»N6,N7 
REAL ESPAR 

IF(INST-£Q.2S}GO TO iOO 

CALL 5LABTCH{MSIH,£SPAR5A»ACNN),Ami) ,ACJ«2) ,AfJl3> ,A CN4) ,A{N5) »A1N6) 
l,A(N7j,AtN2i ,A(N3),A6N4>,A{N5) ,A IND^AfN?} , A (Nl) rA(Ni)) 

GO TO 6000 

iOD GALL £SBTGHCNSIH#£5PARjfA,A{NNj ,A tNl) »A(N2) , ACN3 J ,A (N4) ,A iN51 , A tN61 
IfACN?) ,A£N2) rAtN3J yACN45 ,AeN5) pAfN6l tAfN7j rA(Nl> »ArNlJ ) 

6000 C0NT1&*UE 
END 
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CLABTCH 

SUBRDUTI^4E LABTCH(WSIH,EiPAR,AtRATIO»DHORKf iA,IB,XC,XD,IAPtIF^P» 
1 EVRsEVI,W«,DAKPR,EVRP,EVIPsIRATlD»XBOTQ} 

G VERSION 3-1 revised: OCT 11 1976 

C PURPOSE: PERFORM LINEAR ANALYSIS A«D EIGENVALUE SENSITIVITY 

C ANALYSES. 

C CALL SEQUENCES NSIM ~ MODEL ORDER 
C ESPAR - EIGEN SENSITIVITY PARAMETER 


c 

NAME 




DESCRIPTION 

LOCATION 

c 

A 

— 

NSIM 

X 

NSIM 

WORK ARRAY 

/CWDRK/A(1J 

c 

RATIO 

— 

NSIM 

X 

NSIM 

WORK ARRAY 

/CWQRK/ACNN) 

c 

DHORK 

— 

NSIM 

X 

1 

WORK ARRAY 

/CWDRK/AtNU 

c 

lA 


NSIM 

X 

i 

WORK ARRAY 

/CW0RK/ACN2I 

c 

18 

— 

NSIM 

X 

1 

WORK ARRAY 

/CH0RK/ACN3I 

c 

IC 

_ 

NSIM 

X 

1 

WORK ARRAY 

/CWDRK/ACN4) 

c 

ID 

— 

NSIM 

X 

1 

WORK ARRAY 

/CWORK/A (N5 ) 

c 

lAP 

— 

NSIM 

X 

1 

WORK ARRAY 

/CWORK/A CN6J 

Lp 

c 

IBP 

— 

NSIM 

X 

1 

WORK ARRAY 

/CWDRK/A(N7J 

c 

EVR 


NSIM 

X 

1 

WORK ARRAY 

/CM0RK/ACN2* 

c 

EVI 

— 

NSIM 

X 

1 

WORK ARRAY 

/CWQRK/A&N3B 

c 

WN 

— 

NSIM 

X 

1 

WORK ARRAY 

/CW0RK/AEN4) 

c 

DAKPR 

— 

NSIM 

X 

1 

WORK ARRAY 

/CWORK/A tN5B 

c 

EVRP 


NSIM 

X 

1 

WORK ARRAY 

/CWORK/A £N6J 

c 

EVRI 

— 

NSIM 

X 

1 

WORK ARRAY 

/CWDRK/ACN7J 

c 

IRATIO- 

NSIM 

X 

1 

WORK ARRAY 

/CKORK/A {N1 ) 

c 

c 

XDOTO - NSIM 

DESIGNED by: J«0. BURROUGHS 

X 

1 

WORK ARRAY 
FEB 1974 

/cwork/acn: 


COMMITH /CXIC/XICU J/CINT/INT(1 } 

COMMON /CNTRLS/ANTYPE ,IPRlNT*KDD£,ERRORt i ) 

COMMON /CNAHEX/NAMEXt D/CNAHER/NAHERCl) 

REAL NAMEX»NAMERt£5PAR 

DIMENSIDH DWORKm*IACl}»IBCl},IC(tl} tID{lJ,IRATIO{l) 

REAL EVRUifEVItDsXDDTQClJjAd} ,RATiOU) 

DIMENSION WN { 1) pOAMPRt 1) 

DIMENSION EVRP( UsEVIPUKIAPUl ,I6P£1) 

DATA IP0M/10H+~-t- — *• — 

DATA IASTRX/542H=«=*J/,IBLNK/10H / 

IND£X2{Ilti2TMl)=Il+l 

C LINEAR ANALYSIS CALCULATIONS 

2800 WRITE16»2S02) 

2802 FORHATC iHi/40X»7H/=J'/*/*/»3X»*LIN£AR ANALySlS=«f» 3X?7H/=«=/=J=/=®=//) 
HRIT£i6ff2809HI,h!Af4EX(Ii ,XICa>,ERRORm,lNT(I)»I=lpNSlH) 

2809 FORMAT 1/ 

17Xt 5HSTATE,6X,=»=0PERA11N& PERTURBATION INT£GRATQR=i= 
2 / 8 Xy 4 NAME* 58 X»*PQlNT=*^y 9X ,=t^SIZE*, aX,=J=CQNTROL*/ 

2 £l5,lXsAI0,GI4-5?&i2,3,I9}) 

C =======1=: CALCULATE SYSTEM STABILITY MATRIX 

CALL STASMXlNSIMTXOOTa,ICDUNT,RATID,A,NLINsiJ 
WRITE(6,2813m,NAMEX{ I) »XDOTOU> ,i=i,NSIM> 

2813 FORMATS ///50X, CRATES AT OPERATING P0lNT*/5( I4tlH »A8,3H = ,G11.5)J 
C test if any NONLINEAR ELEMENTS WERE DETECT'’'^ 

IF4ICQUNT-EQ.0) GO TO 2850 
WRITE! 6 » 2849 I ICQUNT 

2349 FORMAT! ///5Xj 14, 2Xfi01HELEHENTS OF /RATIO/ DIFFER FROM 1 BY 10/. T 
XHESE ELEMENTS ARE PRECEDED BY AH ^ IN THE STABILITY MATRIX ) 

DO 2842 1=1, NLIN 
DO 2842 J=1»NLIN 
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J2=INDEK^tIt J,NLIN1 

IFCABStRATl0lJ21“l.J-GT-.i} WRIT E 16 t 2841 I I, JsRATIDt J2) 

2841 FDRHATt20X*’i=RATIQt=fr5l2,=t:,=S=,I2,=«=) ==i^,Gl2-6) 

2842 CDNTIHUE 

c =:==-=::::==== PRINT STABILITY MATRIX 
2850 R=0 

DQ 2855 1“1,WSIM 
IFllNTtI),EQ.O)GO TO 2855 
K=K.+1 

WNCKi=NAHEXm 
2855 CONTINUE 

WRlTE(6,2851UWN{K.ltK-l*NLIN) 

2851 FORMATE/// 47X,=^ST ABILITY HATRIX*/(T10, 10 E 2X,A7, 3X J } ) 

00 2852 1-1, KLIN 

DO 2853 K=1,NLIN 
IRATIDEKl-IBLNK 

IF t ABS L RATIO {, IMD EX21 1 t K,NLIN 3 i-I - ) »GT. • 1) IRATIO £K >= lASTRX 
2653 CONTINUE 

2852 WRITEt6y2843)yN£ I) t£ IRATIO t J},A( I+C J-I 3*NLIN) ,J=^lpNLIN 1 

2843 FDRHATC1X,A7,{T10,1Q(1X,A1,GX0,43 ) ) 

C CALCULATE EIGENVALUES AND NATURAL FREQUENCIES 

2863 CALL EG VL3 C A, RAT 10, EVR» EVI » lA, 13 , 1C t ID? OWQRK, !• E-14, NLIN? NLIN ) 

CALL NATFRQEEVRsEVIsWN,DAMPR,MLIM?NP0LES3 
WRITEC6T2a673 NLIN 

2867 FORMAT E /// 28X* 1 3, 2X? =*=E IGEN VALUE S^/13X ? *REAL*, 9X ,7 IMAGIN ARY:^*? 

1 6X,7MATURAL FR£Q-7t 5X?7DAHPING RATlO^i 

DO 2868 I^lsNPDLES 
J-IBLMK 

IFlEVltI3.GT-0») J=XPQM 

2868 HRITEC6*2869U,EVRU)»J»IEVIUS yWNUj ,DAHPRtI} 

2869 FORM AT ( 3X ? 1 3 , 3X j G1 2. 6 9 2X , A2 , G1 2. 6» 4X , 2G 16 - 6 1 
WRITEt692a71) 

2871 FORMATE/////) 

RETURN 

C *77 CALCULATE EIGENVALUE SENSITIVITY 77* 

ENTRY ESBTCH 

C ========== DETERMINE EIGEN PARAMETER CODE 

CALL CODGEJfelESPARjrOsINDEP) »RETURHS£40003 
C z======= get nominal VALUE OF EIGEN PARAMETER 

CALL VARDUTCINDEP, PARAMO 3 
IFtPARAMD»NE«0«3 GO TO 2950 

C ======= default PERTURBATION = -1 IF NOMINAL VALUE OF EIGEN 

C PARAMETER “ 0 

D£LTA=-1 
GO TO 2955 

G ======== PERTURB EIGEN PARAMETER BY 5 QF NOMINAL 

2950 DELTA=PAtiAM07*Q5 

C ======== CALC. NOMINAL STABILITY MATRIX AND EIGENVALUES 

2955 CALL STABr-5X(NSiMtXDOTO,ICOUNT*RAlIOs AjNLINj 03 

CALL EGVLaiAsRATIOsEVRjEVIjIAalBsICiiDsDWORRj l.£-14,NLINjMHN) 

C ======= ORDER EIGENVALUES YO DECREASING REAL PARTS 

CALL EVORDRCEVRtEVIsIQpNLXN} 

c ====== perturb eigen parameter 

2980 PARAM=PARAH0-4- DELTA 

CALL VARMQDE IH3DEP , PARAH 1 

G ======== CALC. PERTURBED STABILITY MATRIX AND EIGENVALUES 

CALL ST A3MX I H SIM » XDOTO ? I COUNT , RA TIO » A » NLIM ? 0 3 

CALL EGVL3tA»RATI0*EVRP,EVIP9lAP9lBP9lC,ID,DH!0RK,l.E-i4tNLINtMLIN3 
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CALL EVQRDRCEVRPjEVlPvIDpNLlNJ 
DELTA=ABS (PARAMD/DELTA) 
c CALC. EIGEW SENSITIVITY 

DO 3000 l=l,NLIfi 
RATID{Il=EVRtIl 

RATIDtiNDEX2Uj2»NLlN>)=EVItI> 

RATI 05 iNDEXZt X» 3,NLIN ) )=EVRP (I ) 

RATI0(INDEX2CI»6,NLim )=EVIP{I1 
IFCEVRCIJ-EQ-0.1 GO TO 2991 
c -- CALC. SENSITIVITY OF REAL PARTS 

RATI 0 C INDEX2 ( I, 3tNLIN J ) -DELTA* C 1 «-E VRP £ I } /EVR C 1 3 1 
GD TO 2993 

299*1 IFCEVRPUJ.EQ.O.) GO TO 2992 
RATIOaNDEX2(lT3,S4LIN))=l.E36 
GO TO 2995 

2992 RATI0aNDEX2{Ir3,NLIN))=0- 

2993 IFCEYltli-EQ-O.) GO TO 2994 

C ====—==== CALC, sensitivity OF IMAG. PARTS 

RATIOi INDEX2C Is4,NLIN 1 ) = OELTA* ( 1 .-EVIP ( I J /E VI 1 1 3 ) 

GO TO 3000 

2994 IF(£ViP£i).EQ-0-) GO TO 2995 
RATX0tiNDEX2U*4,NLIN) )=1.E36 
GO TO 3000 

2995 RATI0£INDEX2£l44»NLINJ J=0- 
3000 CONTINUE 

WRITE 16530203 ESPAR»PARAHO ,PARAH 

5020 FORMATClHl /20X,7H/*/*/*/9 3Xt*ElGEI4VALJE SENSITI VITY*,3X , 7H/*/*/*/ 
I 53X»AS, * PERTURdED FROM *,Gi2-6,* TO *,G12.6///13X5*N0MINAL EIG 

2ENVALUES*?11X,*S£NSITIVITY MEASURE*, iOXy^PERTURBED EIGENVALUES*/ 

3 ,2X, 31 10X,*R£AL*, 7X,*IHAGINARY*3 /I 
L ===.^== PRINT RESULTS 

WRITE 1 6,3025 3 U , £ RATIO! 1+1 J-i3*NLIW3 , J=l, 6) , 1=1, Nt.IN 1 
3025 FORMAT! 3X, 13, 6G15-6) 

CALL VARMODl INOEP , PARAMO 3 

WRITEt6,287i3 

RETURN 

4000 HRITE16, 40013 ESPAR 

4001 FORMAT C//10X,31H*** WARNING *** CAN*T IDENTIFY, IXjAS, IX, 

1 43MAS A VALID EIGENVALUE SENSITIVITY PARAMETER//) 

WRITE lt», 26713 

RETURN 

END 
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CLPRINT 

SU3RQUTIHE LPRXNTUPRINT jTIME) 

VERSION 3. REVISED!: HAY 5 1976 

PURPOSE; PROVIDE GENERAL LIWEPRINTER OUTPUTS- 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 


CALL SEQUENCES 


IPRINT VALUE 
0 OR i 
2 
3 
A- 
5 


IPRlNT - PRINT CONTROL VARIABLE- 
TIME “ CURRENT TIME. 

QUANTITIES PRINTED 
STATESf RATES, AND TIME 
STATES, RATES, VARIABLES, AND TIME 
STATES, RATES, VARIABLES, C PARAMETERS AT TIME-’O 
STATES, RATES, VARIABLES, PARAMETERS, AND TIME 
VARIABLES SPECIFIED IN PRTNAH ARRAY 
COMM ON/CNAMEX/NAMEX 1 1 3 /CNAMER/NAHER ( 1 3 /CNAHE V/NAMEV 1 1 3 
COHMGN/CMAMEP/NAMEP 1 1 3 

CDMMON/CX/X { 1 )/CXDOT/XDQT{ 13 /CV/V ( 1) /CP/P { 1 3 
COMM GN/CORDER/NOX, NOV ,NOP 

COMMON/CPRlNT/PRlNAMtlO) ,LPRTt 10 3/CDIFS/JSTART,KINlT,TP 
DIMENSION OUTPUT (ID) 

— TEST FOR LIST OPTION 
1FCIPRINT.EQ-53GO TO 300 


ONLY) 


C PRINT STATES 

WRlTEC6,iUTIME,( I,NAMEX{I),X{I3 ,I-1,NDX) 

11 F0RMAT{//10X,*TIME - ^=,G10-4,30X,^STATES^/5t I4-9lX,A8,2H= ,Gllo5)| 

Q print rates, 

WRIT Et 6 , 13 J 1 1 ,NAMER ( 1 3 , XDOT { I ) , I =1,N0X 3 
13 F0RHATC/67X,*RATES^/5( I4,1X,A8,2H= ,SU,5)3 

Q > X£SX poa VARIABLES OPTION, 

IFCIPRIfiftT.LE.lJRETURN 

C > PRINT VARIABLES, 

WRITE£6,i33U,NAM£VCl3 5V(IJ,I=l,N0Vl 
13 F0RHAT£/57X,=i=VARIABLES=i/5[I4,lX,A8,2H= ,SI1.333 

Q X£ST FDR PARAMETER PRINT OPTIONS 

IF C I PRINT «L E -2) RETURN 
IFf IPRlNT«LE-3-AND, TIME. GT.O, 3 RETURN 
WRIT£(6,173 tl,NAMEPtI3 ,P{I3,I-l,NOP3 
17 FDRMAT£/57X,=:=PARAMETERS^/5CI4,1X,A8,2H= ,GI1.33) 

RETURN 

Q > SCAfsj CODES AND GET CURRENT VALUES. 

300 N=0 


DO 320 1=1,10 

C test FOR LAST VARIABLE 

IF(LPRTfiI),EQ.-l3G0 TO 310 
CALL VAROUT{LPRT£I),QUTPUT£I33 
N=I 

GO TO 320 

310 DUTPUT(II=0- 
320 CONTINUE 

XEST FOR NO LIST QUANTITIES IDENTIFIED 
IFCN.LT.DRETUFfN 

C > print HEADING WHEN KINIT = 0. 

IFtKINIT,EQ«03WRIT££6,343) £PRTNAMtII 
3 43 FORM AT £ /4X , IHE=5= , 3X , 1 0 C 3X , AS , IX 3 3 

C > print list VALUES, 

360 WRITE(6,3633TSMEs (OUTPUT «X) ,I=1,N3 
363 FORMATtiX,SI0,4,10Gi2.5S 
RETURN 
END 
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CLUEQS 

SUBRGUTINi; LUEQS( A,B,C,IA»NApJ4B»f!A,Ha,MCf FPZ,IERRORj 
VERSIOlSi 2.0 REVISED = OCT 6 1975 

SOLVES FOR B WHERE A^^B-G 
1J«PUTS are; 

A THE MULTIPLIER MATRIX 
C THE RIGHT HAHO SIDE OF THE EQUATION 
NA THE ORDER OF THE MATRIX A 
m THE HUMBER OF COLUMNS OF MATRICES B AND C 
MA THE ROW DIMENSION OF A 

MB THE ROW DIMENSION OF B 

HC THE ROW DIMEiMSIQN OF C 

FP2 THE PRECISION INDICATOR 

ON SUCCESSFUL COMPLETION i I ERR QR=0} 
a THE SOLUTION MATRIX 

A THE LU DECOMPOSITION OF A 

lA VECTOR OF ROW PERMUTATIONS OF THE LU DECOMPOSITION IN A 

DIMENSION INFORMATION 

lA VECTOR OF LENGTH NA 
MB and HC MUST BE AT LEAST NA 

NDTES5 

IF MB IS 0, ONLY THE LU DECOMPOSITION OF A IS COMPUTED- 

THIS PROGRAM WAS DESIGNED AND CODED BY A. FREDERICK PATH OF 
BOEING COMPUTER SERVICES? SEATTLE? WASHINGTON. THIS VERSION 
HAS COMPLETED DURING APRIL 1975. 

DIMENSION A{MAjl)tBfHB,lJ,CCMC,l)?IA«I) 

£RR=FPZ-i=50. 

IERRQR-0 
DO 10 I=lsNA 
IAU)=I 
10 CONTINUE 
NAI=NA--i 

IFCNA-LE.II GO TO 46 
DO 45 I=l9NAl 
11 = 1+1 
12 = 1-1 

C SEARCH FOR PIVOT 

SM=0. 

00 IS 

IF{ABS( A{ JjI>J-LT.SM) GO TO IS 
IR=J 

sm=absu( j,in 
16 CONTINUE 

C INTERCHANGE ROHS 

IFCI.EQ.IR) GO TO 23 
DO 20 J=ltNA 
SM=A(I,JJ 
A(It J)=A lIRjJj 
A{IR?JJ=SH 
20 CONTINUE 

J=IASI) 

IA{I)=IA(IR) 

IA(IRJ=J 
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C COMPUTE COLUHM OF L 

23 IFUtlTl))24,100,24 

24 

DO 25 
A( J,I1=A{ 

25 COMTINIUE 

C COMPUTE ROW OF U 

IF(I.EQ.l) GO TO 35 
DO 30 J=I1,MA 
SUM=ACI,J) 

SB-ABS(SUM) 

DO 2B K=i,I2 
SA=ACI,K1=*;A(KtJ) 

IF( ABS(SA)-Gl.SB) SB=ABSJSAi 
SUM==SUM-SA 
2S co^mwiuE 

IFCABSISUH) ^LT«tRR^SBJ SUH=0. 

30 A{I,Ji=SUM 

C COMPUTE UPiMORMALIZED COLUMM OF L 

35 DO 45 J-IlsNA 

SUM=ACJ,Ii} 

:iB=ABS(SUM) 

DO 38 K=1,I 
SA^AU»K.)*A(K,X1) 

1F{ABS(SA}«GT«SBI SB=ABStSA) 

SUM-SUM-SA 
3a CONTINUE 

IF(ABSISUR5.LT-£RR*SB) SUM=0. 

AtJsIi)=SUM 
45 CONTINUE 

46 IFtAlNAfNAJ )47,100#4T 

47 AiNABNA):=X./Al.NA,NAl' 

CALL SLVEQtA,BTGyIA,NA5NB,HA»MB?HC*FP2*iERR0R) 
RETURN 

100 WRITEtOtlOlJ 

101 FORMAT 1 27H0 ** MATRIX IS SINGULAR =5=^) 

I£RRDR=1 

RETURN 

END 
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SUBROUTINE NAMES tIPHRS jNAKE,NUNIT,NO, ITND yMODE) 

purpose: loads alphanumeric names of quantities identified by 

DEFINE STATEMENTS. 


CALL sequence: 


IPHRS 

NAME 

NUNIT 

NO 

ITNO 

MODE 


= ARRAY CONTAINING NEXT PHRASE TO BE EXAMINED- 
= ARRAY TO BE LOADED WITH NAMES OF 
DEFINED QUANTITIES. 

= ARRAY, TO BE LOADED WITH UNIT NAMES 
OF DEFINED QUANTITIES. 

= NUMBER OF DEFINED QUANTITIES. 

= POSITION OF GIVEN QUANTITY IN NAME ARRAY- 
= MODE OF OPERATION INDICATOR. 

MODE =0 WHEN ITNO HAS BEEN LOADED, 

MODE = 1 WHEN NAME HAS BEEN LOADED. 

DIMENSION NAMECNOl jNUNITtNO) 

REAL IPHRS, NAME, NUNIT 
C TEST FOR NUMERIC FIRST CHARACTER- 
CALL NUHERC ( IPHRS 1 ,RETURtNS( 100} 

SO To 2.00 

C TEST THAT ITNO IS WITHIN ALLOWABLE RANGE. 

XDO IFUmO-LT.l.DR.ITNO.GT.NO) GO TO 120 
IF(MODE-NE-O) GO TO 110 
C LOAD NAME 

NAME t UNO )=IPHRS 

M0DE=1 

RETURN 

C LOAD UNITS NAME, (ALL NAMES WILL BE PUT IN WORD 1 FDR NOW.} 

110 NUNITCI )=iPHRS 
RETURN 

120 WRITECS,121} ITNO, IPHRS 

121 FORMAT WARNING ***,I8,40H EXCEEDS THE ALLOWABLE INDEX R 

IAN GE FOR ,A10,34H THIS QUANTITY WILL NOT BE DEFINED) 

RETURN 

C CONVERT IPHRS TO I FORMAT. 

200 CALL BCDRELCFLNO, IPHRS) 

ITNO=FLMO 

M0DE=0 

RETURN 

END 
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CNATFRQ 

SUBROUTINE NATFRQlEVa»EVIyWN,DAMPR,NUm,NPQLES) 

PURPOSES TO ORDER EIGENVALUES WITH HOST POSITIVE REAL PARTS FIRST? 
CALCULATE NATURAL FREQUENCIES AND DAMPING RATIOS? 

AND TO ELLIMIWATE THE ROOTS WITH NEGATIVE IMAGINARY PARTS. 
CALL sequence: EVR = REAL PARTS OF EIGENVALUES (NLIN ARRAY ON ENTRY 

NPOLES ARRAY UPON RETURN- > 

EVI = IMAGINARY PARTS OF EIGENVALUES 
WN = NATURAL FREQUENCY ARRAY 
DAMPR = DAMPING RATIO ARRAY- 
NLIN = SYSTEM ORDER. 

NPDLHS = NUMBER OF POLES WITH IMAGINARY PARTS >= O- 
DIMENSION £VR{ 1) , EVK IJ ?WNC1) , DAMPRt li 
NP0LhS=0 

C ELLIMINATE ALL POLES WITH NEGATIVE IMAGINARY PARTS- 
DO 50 1=1?NLIN 
IFCEVim -LT-Ol GO TO 50 
NPQLES=NP0LES+1 
EVR { NPOLES I =E VR t I ) 

EVU NPOLES l=EVlt I) 

50 CONTINUE 

C SORT REAL PARTS OF POLES INTO ASCENDING ORDER- 
CALL FSHELLtEVR»WN»J«POLES} 

C SORT IMAGINARY PARTS TO CORRESPOND TO REAL PARTS- 
CALL SHELLXCtVIjWNrNPOLES) 

C REVERSE EIGENVALUE SEQUENCE. I PUT INTO DECENDIMG ORDER) 
NLIN1=NP0L£S+1 
NLIN2=NP0LES/Z 
DO 100 I=l?NLDi2 
12=NLIN1-I 
fcVRS=EVR(II 
EV1S=EVI£I) 

£VRtI)=EVR(I2) 

EVI{ I)=EVIiI2J 
EVRCI2)=EVR5 
100 £VIU2)=EVIS 

C CALCULATE NATURAL FREQUENCIES AND DAMPING RATIOS. 

DO 200 1=1? NPOLES 

WN(I }=SQRT(EVR( I) *EVR Cl) +EVI tl )*EVU I ) ) 

DAMPRa}=0- 

IF ( WN { I ) -J»E - O . ) D AH PR £ 1 1 =~E VR £ 1 1 / WN C I J 
200 CONTINUE 
RETURN 
END 
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CNONSIK 

0VERLAYtN0NSIH,0,0) 

PROGRAM N0MSIMUMPUT=100,OUTPUT=200,TAPE5=INPUT,TAPE6=DUTPUT, 

1 TAPfci=600, PUNCH=100,TAPE3=PUNCH,TAPE30=1000,TAPE25=1000> 

C VERSION 3. revised: APRIL 30 1976 

C PURPOSE; MAIN PROGRAM FOR THE BATCH VERSION OF NDNSIM- 
CQMMDi^i/CDVRLy/INSTtLOKSSjLOKSIMfCPUSEC 

CQHH CW/CPRO V/XMINl , XH AXl s XH IN2* D ELTA2 , CURVES , PRIOT »P RATE « OUTR AT j 

1 AHODE,TINC,TMAX»FHAXfFMIN,XSTARTfXSTOP,SPOmT,SSLIH,RSTART,RSTOp7 

2 RPOINT r RLHIN,RLHAX t IMHIN, IMHAX, QCHQD,QCORD y TZERD 
C0MM0N/CPR0N/DEP£N,lNDEPlylNDEP2»£SPARyNINPUTyN0iiT,lNDEP,RLPAR 
COMMON/CSHPAR/SMPAR( 10 J r ICIND { 2) 

COMM ON/ C GR D ER/NS IM ,MQ V , N OP /CWO RK N/NN , N C7 J 

COHMON/CS IH UL/1 PRIta, IP RATE > IQUTr MPTSjNiPTHAX , INDM AX ,TINC2 , THAX2 , 

1 IND£X,1PL0T,I0ENT{4) 

REAL IDENT 

EQUIVALENCE INSIK.NOX) 

COMMON /CPLDTS/ lNDPLT»INDWR,IOPTt30),PLOTlD{ 5),PTITL£t S) , 

•v IPOPTCIO) 

REAL SHPAR,DEPESi,iNDEPlilMDEP2,ESPAR,NlNPUT»N0UT,l!NDEP9RLPAR 
C CALL USER FURNISHED INPUT ROUTINE. 

CALL DATA IN 

CALL OVERLAY (4HINIT# 1,0} 

INST=i 

C INTERPRETATION ROUTINE TO READ INSTRUCTIONS- 
lOO CALL □VERLAYt6HINTERP,2,0,6HRECALL) 

IFUNST-LE.OJ STOP 
C BRANCH TO SPECIFIED ANALYSIS. 

SO TO (100,100,100, 100, 100, 100, 100, 100, 100,100, 

1 100 , 100 , 200 , 200 , 100 , 100 , 100 , 100 , 100 , 100 , 

2 100,100,100,100,100,300,400,400,500,600, 

3 TOO, BOO, 420,100, 800,100, 100, 100, 100, 100, 

4 100,100,100,100 ,100,100,100,100,100, 100, 

5 100,100,100,100,1000,100,100) ,INST 

C GENERAL FUNCTION OF ONE INDEPENDENT VARIABLE. 

200 CALL 0VERLAY(6HGFBTCH,3,0) 

GO TO 100 

300 IFaOKSIH.EQ-l) £Q TO 310 
WRITE16,301) 

301 F0RHAT{//S5X,15H4:i:=S: WARNING 5X,+SiMULATI0N WILL NOT BE RUN DUE 

1 TO FAILURE TO REACH VALID STEADY STATE*//) 

GO TO 100 
310 IPRIN=PR1MT 
IPRAT£=PRATE 
10UT=DUTRAT 
TINC2=TINC 
THAX2=THAX 

CALL OVERLAY (6HSIBTCH, 4,01 

L0KSS=1 

GO TO 100 

400 CALL OVERLAY [6HLABTCH, 5,0) 

GO TO 100 
420 CONTINUE 
GO TO 100 

500 CALL OVERLAY S6HSM&TCH, 6, 01 
GO TO 100 

600 CALL OVERLAY (6HTFBTCH,7,0) 

GO TO 100 
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700 


CALL 0VERLAY(6HSSBTCHtl0B,0) 

GO TO 100 
800 CALL DVERLAYt6HRLBTCH»llB>QS 
GO TO 100 

^ GENERATE LINEAR SYSTEM MODEL 

00 CALL OVERLAY {6HNDNSlMrl2B, OS 

GENERATE OPTIMAL CONTROLLER 

CALL OVERLAY I 6HNONSIHrl3BaOJ 
GO TO iOO 
END 


— PROGRAM D 

- PROGRAM OC 
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CNRKV 


OVER LAYtNDNSIH,4,li 
PROSRAH «RKV 

C PURPOSES PERFORM XNTERATION USING RUNGE-KUTTA ALGDRXTHIM 
C VERSION 1» REVISEDs JULY 11 1975 

COMM ON/CX/X { I ) /CXDDT/XOQT 1 1 } /CTI ME/T IM E/CORDER/NSIM , NO V » NOP 
C0HM0N/C«DRK/ACl>/CW0RKi«/NM,Ml»N2jS«3,N4,N5»N6,N7 
COHMON/CNTRLS/ANTYPE,IPRIN7 tIMQDE, ERROR (1) 

CGM«CWCSIMUL/IPRIN,IPRATEtIOUT,WPTS,N|PTHAXtINDMAX,TIN[CtTHAX 
CDMMON/NRKVS3/IDIAGrAHMINH,AHSTRT9lNTFLG,MAXNFMFAILl»KSTEP2,ISTABL 
COMMDN/CDIFS/JSTART,KINIT,TP 
lFfKlWlIT.£Q-0) GALL RKINIT 

CALL NRKVS(TP,NSIH»A(fiNi»ACWlJ , A (N2) , A CM3) , ACi«4J ^ACNS} » A CN6) , 
1ACN7)) 

END 
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CNRKVS 


SUBROUTINfc fiRKVS(TP,NVxXX,XSrDS,ZiiZ,OHIST,XHlST,ECKT> 

C VERSION 2-1 REVISED: MARCH 23 1976 

COMMON/CX/X { 1 )/CXDQT/XDOT C 1 J /CTI ME/TIHE/CDRDER/NSIM 5 NOV , NOP 
COMM UN/CNTRLS/ANTYPE r 1 PR INT , IHODE , ERROR { 1 ) 

COHMCb/CSIMUL/I PRINj IPRATE , IOUT,3*PTS ,HPTHAX » INDM AX ,TINC, TMAX 
C0HM0N/NRKVS3/ID1A6 tAHMINK,AHSTRT,INTFLG,HAXNtHFAIL 1»HSTEP2,ISTABL 
CQHMuH/CDIFS/JSTARTtKINlT/ERHESS/IFATALsIERR 

DIMENSION XXli)fXStl),DStl),m),22tl),DHIST{l),XHIST(l),ECNT(l) 
LOGICAL REJECT, RETRN 

DATA XRHQyDRHO/- 99, -75/, A, B,C/ -43660211 T3,27faI45<?v 2-7327480/ 
ERR-l-E-5 

INITIALIZATION FOR FIRST CALL TO THIS PRO&RAH- 
ASSICNMcNTS ARE MADE SO AS 

TO USE EITHER SIHPSDAiS RULE DR RUMGE KUTTA FORMULAS 

CHECK FOR NV EXCEEDING DIMENSION SIZE 

RETRN = -FALSE- 
1TERCT=^0 

IFCKINlT-GT-01 GO TO 20D 
KINIT = 1 
REJECT = -FALSE- 
108 DO 120 1=1, NV 
DHlSTdl = 0.0 
ECNT{I)=0- 
XXU) = XU) 

XHISTII) - AHAXltABSlXU) } ,ERRQRII) } 

IF IXHISTUH 110,110,120 
110 XHIST(l) = 1,0 

120 CONTINUE 
1S=TIHE 
TR=TP-TS 
IFTTR)lI,10,il 

10 CALL E0M0tTIM£,TINC,03 
RETURN 

11 CONTINUE 

C SET STABILITY CONTROLS 

AHHAX=1- E+37 

13 JLMAX=100 
TSTBL =4- 
TSTBL2=2- 
RTDN =-75 
RTUPl =-25 
RTUP2 =.75 
JDELAY=5 
JHIST =0 

14 JLDCAL=0 

C INITIAL STEP AND MINIMUM STEP - SET BY USER OR PROGRAM 

IFCAHSTRTJ 122,122, 121 

121 AHS = AHSTRT 
GO TO 123 

122 AHS =.0 1=PABS C TP-TS ) 
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X23 IF(AHHINM}i25,125,i24 
124 AHMIN == AHMINM 
GO TO 200 

125 AHMIN“AHINEi(l-£-5,TIMC/1000a-} 

0 

C ■ 

C INIT1ALIZ.ATX0M FOR SUBSEQUENT CALLS TO THIS PROGRAM 

C CONTINiUATIDN OF AM INTEGRATION AFTER A NEW 

C PRINT TIME (TP) IS SET 

C EVALUATE DERIVATIVES AI STARTING POINT 

C 

200 ENDT = TP 

CALL EQMOlTIHEjTiNCsO) 

DO 210 1=1, NV 

xxa}=Kti) 

210 DSTI) = XDOTCI) 

TR = TP-TS 
IRE J EC =0 
TTEST = TS 
TEST= .003=5‘ABStTRJ 
NSTEP =0 
NSTEP2= 0 
NFAIL1= Q 

C 

C 

C RUMGE KUTTA FORMULAS 

C A ONE STEP, FOLLOWED BY A TWO STEP, INTEGRATION IS PERFORMED. 

C THE INCREMENTS TO THE DEPENDENT VARIABLES ARE FOUND IN Z,2Z 

C=?=={!:^=fr 

C DO QME STEP OF LENGTH H 

300 AH ==AHINItAHS,ABSlTR>) 

H=SIGNtAH,TR) 

H2= 

Hfa= H2/3. 

TIME = TS+ H2 
DO 302 t=l,NV 
XS{Il=XX{I) 

302 X(I>=XS(I)+H24^iStI) 

CALL £QH0{TiH£,TINC,O) 

DO 304 1=1, NV 

ZE1)= DSfD+Z.^i'XDOTa} 

304 X(ll= XS(n+H2=J=XD0T[I) 

CALL EQH0{TIHE,TINC,0) 

TIME =TS -t-H 

DO 306 I=1,NV 

2(I)= Z{Ii+ 2-=«^XD0T(I) 

306 X(I)= XStI)+H*XODTm 
CALL EQMQ (TIME, TING, 0} 
htt-=-25*H 
H12=H4/3. 

TIME=TS+ H4 

DO 310 1=1, NV 

Z ( I ) =H6=4^U( 1 1 +XDOTC I S > 
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C 

C DO FIRST HALF STEP OF LENGTH H/2 

310 xa)=XS{I]+H4*DS(l) 

CALL EQHQdIMEjTINCjO) 

DO 314 I=1tNV 

22 tl 5 “DS ( 1) +2- =f=XDOTC I } 

314 X{I>= XSt I) +H4’i'XDDTCI} 

CALL EQH0{TIKE,TINC,0J 
TIM£^^TS+H2 
DO 316 I=1»NV 
22{IJ=2Z(IJ+2,*XD0TCI) 

316 XCIJ= XSI£)+H2*XD0TfIJ 
CALL EQHC{TIM£tTINC,0) 

c 

C%44^ 

C SET UP SECOND HALF STEP 

e 

DO 3 20 I=ljNV 
2Z{I)=Z2Cl}-s-XD0T£lJ 
Xtl)= XSa)+Hl2=s=22tIJ 
320 XS£I)=X(IJ 

CALL EQHO{TIME,TINCtO) 

C 

C DO SECOND HALF^STEP OF LENGTH H/2 


T1HE=TIH2+H4 

DO 322 I-1tNV 

X ( I }-XS 1 1) +H4=i=XD0Tt I ) 

322 Z2£Il=ZZ{IJ+XD0T£i) 

CALL EQHOiTIMEjTINCjO) 

DO 324 i-l,NV 

2Z(I )=ZZ(I)+2-^XDDT(I) 

324 XU) = XS(I)+H4=«=XD0T£r} 

CALL EQMOC TIME, T INC, 0) 

TIHE=TS+H 

DO 326 I=1,NV 

ZZ { I }=ZZ ( I ) +2.*XD0T L I ) 

326 XCI)= XS[I)+H2’S=XDDT(I) 

CALL EQH0(TIHE,TINC,0) 

00 330 I=1tNV 

33.0 2ZtI)=H12*^(ZZai+XD0T{I) J 
C NOW GO TO ERROR CHECKING SEQUENCE 

C 

C ERROR CHECKING SEQUENCE. 

C IN THIS SECTiDNjTHE SIZE STANDARD IS UPDATED, THE ERRORS ARE 

e COMPUTED, THE WORST ERROR IS COMPUTED, AND DECISIONS ARE MADE 

C AS TO HOW TO PROCEED- 

500 TERR= 0- 

RECIP = 1./AH 

IERCT=0 

DO 508 I=1,MV 
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CHNG=AHAX1 { ABS UC I n s ABS C ZZ 1 1 n > 

Z( I J=tZ2LtI)~Z un/15, 
lF{CHMG-£RRDiUI)) 50A,504,506 
50A OHISTtI>== 0. 

GO TO 508 

50 8 DHISTU)= AHAXl{CHNG*R£CIP»DRHQ^DHISTtI)r 
C+^5(e^ 

C SIZE STANDARD 

tRRSTD=AH AXl { DH 1ST 1 1 } *AH t XH 1ST 1 1 ) ) 

C ERROR FOR EACH EQUATION 

RERR =ABS t Z C I } / 1 ERRSTD+^ERIU > 

RERR=AHIN1 1 RERR , Z { I ) =«^5 0 ./ERROR U ) ) 

C WORST ERROR FOR ALL EQUATIONS 

IFITERR-&T-RERR1 SO TQ 508 
TERR=RERft 
IERCT=-I 
SOS CONTINUE 

c 

C NOW PROCESS ITEST TQ DECIOc WHAT TO DO WITH THIS 

C INTESRATIDN CYCLE 

C 

C IF TERR.LE.l THEN THIS STEP IS SMALL 

IFtTERR-.LE.l-) GO TO 512 
C REDUCE JHIST 

IFUHIST) 511,510,509 

509 JHIST=JHIST-1 

C IF TERR-Gl-TSTBL THEN INVOKE STABILITY 

510 IFtTERR-LT.TSTBLl GO TO 519 

C ONLY IF PREVIOUS STEP WAS SMOOTH 

IFULOCAL-EQ.O) GO TO 511 

C Wfc ASSUME WE HAVE EXCEEDED THE 

C RANGE OF STABILITY- TIGHTEN CONTROLS 

C 

AHMAX =AH=«=RTDN 

TSTBL =L-+-5*TSTaL 

RTDN =,75^RTDN-i-, 2421875 

RTUPl -.5*RTUP1 

RTUP2 =L--RTUP1 

JLQCAL=0 

JHIST =0 

IFtJDELAY.LT.20l JOELAY-JDELAY+Z 

04^4^* 

C CHECK FOR REJECTION 

511 IF(TERR-IO-) 520,520,515 
C**=»:* 

C STEP ACCEPTED - NEXT STEP INCREASED 

512 IFt ABStTR)-AH) 521,521,513 

513 IF(REJeCT) GO TO 600 

AHS- AMI N1 1 2-0 ,11- +C4TERR) / 1 A+B+TERR3 } ^AH 
C INCREASE JLOCAL AND JHIST tSOUNDED) 

IFt J LOCAL. GT-JLM AX) GO TQ 514 

JLQCAL=JLDCAL+1 

JHIST =JHIST+1 
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C BQUPID AHS 

514 IFCAHHAX-Gfc.AHSJ GO TO 600 

C CHECK FOR AHHAX. TO INCREASE 

TEMP = AHS 
AHS =AHMAX 

IFCJLOCAL-LT^JDELAYJ GO TO 600 

C INCREASE AHMAX USING RTUP PARAMETERS 

AHHAX =T£MP*RTUP1+AHHAX+-RTUP2 
JLQCAL=0 
GO TO 600 

C STEP REJECTED 

515 REJECT - *TRUE* 

ECNT UERCT) =fcCNT{I£RCT}+i 
IRE J EC IRE J EC +1 
IFUHS-GT-AHMIN) go TO 518 
NFAILL =NFAILX -*1 
XFCNFAILl.GT.l! GO TO 516 
TF1=TS 

516 TF2=TS 

GO TO 700 

516 AKS=AMAXlCAHMlN,AHAXlU5 9ETERR=i=A'i'a)/iTERR+CJ )=»=AH1 
GO TO 300 

STEP ACCEPTED ~ NEXT STEP DECREASED 
IF TERR-&T»2 ERROR IS MODERATELY SEVERE 

519 IF(TERR-LT»TSTBL2J GO TO 520 
IF(JDELAY*.LT-20) JDELAY=JDELAY+1 

520 AHS=AMAXiCAHMlN,{(TERR*A+B}/(TERR-i-CJ )4:AHI 
IFCJlOCAL.EQ-O) go to 522 
JL0CAL=0 

CHECK FDR AHHAX TO DECREASE 
IFUDELAY-LE.IO) GO TO 522 
AHHAX -AHHAX*aTDN+AHS=t=tlo-RTDNJ 
RTUPi -RTUP1^»875 
RTUP2 =i.-RTUPl 
JHIST =0 

522 IFC ABSCTRJ-AHJ 521,521,600 

521 RETRN =-TRUE- 


SYSTEM UPDATE SECTION- 

AT THIS POINT A STEP HAS BEEN ACCEPTED, UPDATE THE SYSTEM 
VARIABLES AND PREPARE FOR A NEW STEP UNLESS TP HAS BEEN 
REACHED OR A DIAGNOSTIC MESSAGE IS REQUIRED- 
600 REJECT -.FALiSE- 
610 DO 620 1=1, NV 

2{i)=ii(i)+zai 
xtii=z(i)+xx(ii 

XX ( I J = X{ I J 

620 XHIST(I1= AMAX1{ABS(XCI) J,XRHD*XHIST£I} ) 

T1ME=TS+H 
TS=TIHE 

C turn on error messages in MODEL 

622 lERR = 1 

CALL £QHO(TIME,TINC,OJ 

Q ^ Opp ERf^QR messages in MODEL 
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I£RR - 0 

Qt}c:sc5f; IP gear integrator mode is specified return after 100 STEPS 
ITERCT=ITERCT+1 

IF ( IHODE - £Q « 1 - AND- ITERCT -GT- 100 J RETURN 
624 DO 630 I=ljNV 
630 DS(I)=XDDTtIi 
NST£P=NST£P+1 

CHECK FOR SMOOTH OPERATION 
IF(JH1ST-LT.201 GO TO 633 

YES - LOOSEN STABILITY CONTROLS 

JHIST =0 

TSTBL =»3+TSTBL+2. 

RTUP2 =«5+RtUP2-r»373 
RTUPl =1-“RTUP2 
RTDN =-?5*R10N+,.lB75 
1FIJ0ELAY»GT,51 JDELAY=J DELAY-2 

63^ IFiIDIAG-EC-0} GO TO 636 

IFiNSTEP«LE«HAXN} GQ TO 730 
636 IF£TP-ES«DT)638*640,638 
638 TP=ENDT 

IFtENDT-EQ.TSJ RETURN 
RETRN == -FALSE. 

640 TR“ TP- TS 
IRE J EC - 0 
IFCRETRHJ RETURN 
NSTEP2 = NSTEP2 + 1 
If (NSTEP2-LT.HSTEP2) SO TO 300 
IF tABStTS-TTEST)-TESTJ 7iOr7lOT644 
644 TTEST =TS 
NSTEP2= 0 
GQ TO 300 

DIAGNOSTIC SECTION - 

THREE LEVELS OF DIAGNOSTICS ARE POSSIBLE, TWO OF 
WHICH CAUSE AM ERROR RETURN 


l.IF AN ERROR TEST IS NOT SATISFIED AT MINIMUM STEP, 

A MESSAGE IS PRINTED. THIS IS ALLOWED TO HAPPEN 
AT HOST HFAILl TIMES AT WHICH TIME 
THE ERROR RETURN IS MADE 

700 WRIlTE{6,702) TS,RERR 

702 F0RMATC1H0,23HERRQR CHECR FAILURE AT , E14.S, lOX, 23HERR0R INDICATO 
IRS FOLLOW,/, ilH F9-3,9F9 .3 H 
IFCNFAILI-LE-HFAILl) GO TO 610 
WRIT EC 6, 7041 

704 F0RHAT£1H0,51HEXCESSIVE ERROR UiECK FAILURES AT MINIMUM STEP SIZE} 
WRiTE£6,706) TS,(Xa) ,I~i,NV J 
706 FDRMAT£iH0,26HlNTEGRATIQN TERHIMAIED AT ,E14»8, 

150H WITH the FOLLOWING DEPENDENT VARIABLE EVALUATIONS, t/S El 4. 8 H 
WRlTE(6,70a}TFl,TF2 

708 F0RMATtlH0,51HFIRST ERROR FAILURE AT MINIMUM STEP FOR INOEP VAR =, 


134 


BCS 40262-2 


ono onc'ioonn ooooooon 


IE16«8/52H LAST ERROR FAILURE AT MIJ^IKUH STEP FOR IftIDEP VAR =,El6o 
28) 

oD TO 900 


C 

c. 

2- IF AM ISSTEGRATIOM TAKES MSTEP2 STEPS IM A SMALL 
FRACTION OF THE CURRENT PRINT INTERVAL £TEST IS 
THE VARIABLE SET TQ THIS FRACTION) IT IS LIKELY 
THAT EXCESSIVE COMPUTER TIME WILL BE CONSUMED 
BEFORE THE PROBLEM IS COMP LETEDs- THEREFORE 
THE ERROR RETURN IS MADE 

710 WRITE (6,712) MSTEP2,TTEST,TS 

712 FDRHAT(1HO,31HIMTESRATIOM PROCEDURE REQUIRED ,I3,6H STEPS/lHO p 27HF 
IROM INDEPENDENT VARIABLE =,E14.8/28H TQ INDEPENDENT VARIABLE =,E 
214-B/iH0,40HCDMPUTATI0N CONSIDERED PRDHIBITIVLY SLOW) 

WRIT£(6,706) TS,{Xtl) ,I = i,W) 

IF [MFAIL1-ME*0J WRITE « 6,708) TF1,TF2 
CO TQ 900 

3. AS A DEBUGGING AID, A DIAGfdSTiC MAY BE PRINTED 
EACH STEP, HOWEVER, NO MORE THAN MAXN OF THESE 
CAN BE PRINTED IN EACH PRINT INTERVAL- THIS IS TQ 
PREVENT THE INADVERTENT GENERATION OF 
EXCESSIVE OUTPUT- 

730 CONTINUE 

WRITE { 6 , 742 J NSTEP , IRE J£C,TS , H, AHMAX, TERR, RERR 
742 FORHATUH ,2i4,4EI4-p, 6F&-2,/,(lH iOX,15Fd-2)) 

GO TO 636 

WHEN PROCEDURE STOPS BECAUSE OF ERROR, SET TIME TO THAX + RETURN 
900 TIME=TMAX+i 
RETURN 
END 
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CPLiS«lT 

SUBROUTINE PLINIT 
INITIALIZE FOR PLOTTING 

COHMaWt /CPLOTS/ INDPLTtINDWR,I0PT(301,PLDTIDE 5},PT1TLEE 8>s 
+ IPOPTtiO} 

COMMON /CSCALE/ 5CALE( 5? A-,6) tNVAR{5,2t6) ,NPLTS(6 J 
DIMENSION DFLTID(5) 

DATA BLNK /lOH / 

DATA DFLTID /50H NONSIM PLOTS 
+ / 

REWIND 30 
INDPLT =0 
INDWR = 0 
DO iO 1-1,30 
10 lOPTtl) - 0 
DO 20 1=1,5 

20 PLOTXDill = DFLTID (I ) 

DO 30 1=1,6 
30 PTITLEliJ - BLNR 
DO 40 1=1,10 
40 IPOPKIi =0 
IPOPTtS) = 1 
DQ 50 1=1,6 
50 NPLTStll = 0 
RETURN 
END 
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CPLOTAB 

SUBROUTINE PLQTABtNTABS 

C VERSION 1. REVISED HAY IS 1976 

C PURPOSE; PLOT TABULAR DATA 

C CALL SEQUENCE: NTAB ~ I„D* NO» QF TABLE TO BE PLOTTED 

C NTAB - -1 IINOECATES ALL TABLES ARE TO BE PLOTTED 

C DESIGNED BY: J.D. BURROUGHS MAY 1976 

C0HMaN/CPLQTS/INDPLT,lNDWR,IOPTl3O>,PLOTID£5J,PTlTLE{6JyIPOPT (10) 

COMM ON/CTABNA/IABNAH £ 1 ) /CHAXD I /NOTAB? MAXDIH £ 1 1 /CLOCT A/LQCTAB4 1 J 
1 /CTA&LE/TABLEStl) 

REAL xopnaoj 

EQUZVALENCECXOPTdJ ,iOPT(l)l 
DATA IBLNK/lOH / 

C ======== test if all tables are to be PLOTTED 

IFSNTAB.EQ.-UGO TO 100 

c plot one table 

n=NTAB 
N=NTAB 
GO TO 200 

C PLOT ALL TABLES 


100 Il=i 

N=NOTAB 

C =======:== SCAN TABLES TO BE PLOTTED 

200 DO 40GQ X=I1,N 
I0PTC3J-1BLNK 
I0PT£4)s::IBLNK 


c ££7 date and time 

CALL DTTIHtI0PT£3)) 

C GET STARTING LOCATION OF TABLE DATA 

LOC=LOCTABtlJ 

C SELtCI GENERAL FUNCTION PLOT OPTION 

I0PT£1}=^1 

C r— ADVANCE CASE NO* COUNTER 

laPT{2)=I0PT£2)^M 

C LOAD TABLE NAME 

X0PTt6)=TABNAH£l) 

C PRIMARY INDEPENDENT NAME 

X0PT(6J=7HPRIHARY 

C — SECONDARY INDEPENDENT NAME 

X0PT£7J=7HSEC0ND 
DO 3 100 J=8 T 13 

3100 iaPTfJl=tt 

L NUMBER OF PRIMARY PDIJITS 

NX=TABLESCLQC+I> 

I0PTU4J-NX 

C NUMBER OF SECONDARY POINTS 

NZ==TASL£S(L0L+2i 

lF(M2-LE.l)«2=is 

C — LIMIT NO- OF SECONDARY POINTS TO 15 DUE TO lOPT DIMENSIONS 

N2LIP5=MIN0{N2*15) 

I0PTfl5)-NZLIH 

C =========== load SLCOMDARY INDEPEi^DENT VARIABLE TABLE 

DO 3200 J^ljNZLIM 

3200 X0PT£J+15)=TASLES£ LOG'S- 2+J) 

WRITE t 30 ) lOPT 9 P LOT ID , P TI TLE 
LINDEP-LOCtNZ-s-2 

C ========== SCAN SECONDARY POINTS ========= 

WaiTE£30) £( TABLESJ LDC-i-J*!«X+NZ+2^^K) jK=l»NX J t 5 TABLES t LINDEP-HU , 
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I K=1*NXJ »J=X,NZLlHi 
4000 CaNTINUe 
INDWR=1 
RETURM 
END 
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SUBROUTINE PREC2{ A rB,D»rAtIB,IC,ID*NISH,N(f M) 

C SUBROUTINE TO PRECONDITION A MATRIX A BY REDUCING IT TO 
C UPPER BLOCK TRIANGULAR FORM AND SCALING 
C A IS N ORDER MATRIX, AND IS UNCHANGED BY PREC2 

C B IS N ORDER MATRIX WHICH CONTAINS PRECONDITIONED MATRIX 

C DN OUTPUT 

C D,IA,IB,1C, AND ID ARE WORK VECTORS OF DIMENSION GREATER THAN N 

G ON OUTPUT, lA CONTAINS THE ORDER OF THE VARIABLES, IB 

C CONTAINS THE NUMBER OF VARIABLES IN EACH IRREDUCIBLE SUBBLDCK 

L NSM IS OUTPUT INDICATING NUMBER OF BLOCKS ON THE DIAGONAL. 

C iC CONTAINS LOCATIONS OF LAST ELEMENTS IN DIAGONAL SUB BLOCKS 

C D CONTAINS SCALE FACTORS ASSOCIATED WITH REARRAPSGED VARIABLES 

C 

C THIS PROGRAM WAS DESIGNED AND CODED BY A, FREDERICK PATH OF 

C BOEING COMPUTER SERVICES, SEATTLE, WASHINGTON- THIS VERSION 

C HAS COMPLETED DURING APRIL 1975- 

C 

dimension A«M,1),B(M,1),DC1),IA{ 1),IBC1),IC( 13,ID{ i) 

C APPLY MC CREIGHT ALGORITHM FIND UPPER BLOCK TRIANGULAR FORM 

DO IBO I=1,N 
130 ICII}=I 

CALL EQVCLCN,H,A,IC,NSH,IAvIB,iDj 
C SCALE IRREDUCIBLE BLOCKS ON DIAGONAL 

IK=0 

DO L40 I=-1,NSM 
IL=IB(IJ 
ICtI)=IK-ML 
DtiK-**IL)=i. 

IF{IL-LE.1) GO TO 140 
DO 135 K=I,IL 
KK=IAUK+K) 

DO 135 L=1t 1L 
LL=IAlIK-*-L) 

135 B(K,U=A{KK,LL} 

CALL SCALECSjDt IK+i) ,IL,M> 

140 IK=IK+IL 

C APPLY SCALE FACTORS TO ENTIRE MATRIX 

DO 142 I=^1,N 

142 DCI)=1-/D(IJ 

143 11=1 

DO 150 1=1, NSM 
JJ=II"1+IB(I) 

DO 149 
L=1A{J) 

DO 149 K=i,N 
KK=IAIK1 

IF(K-GE.II3 GO TO 145 
B(J,K)=0- 
BCJ,K)=0- 
GO IQ 149 

145 IF(K.NE.J) GO TO 147 
BIJ,K)=A IL,KK) 

GO TO 149 

147 BtJ,K)=A[L,KK)4'DfKJ/DCJ) 

149 CONTINUE 

150 H=JJ+1 
RETURN 
END 
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SUBROUTINE QNMTECXvN ,NRtFUN,P,TOL,ITHAX»IPER,MTRtRHS»AJ fS» 

1 ERRORjNSIH) 

VERSION 3. REVISED: JUNE 7 1976 

purpose: solve system of nonlinear algebraic EQUATIONS - 

0 = FtX) 

CALL sequence: X - SOLUTION VECTOR UPON RETURN- INITIAL GUESS 

UPON ENTRY- 

N - NUMBER OF VARIABLES 

NR ” DIMENSION OF JACOBIAN MATRIX » AJ 

FUN “ NAME OF SUBROUTINE CONTAINING NONLINEAR FUNCT 

EVALUATION- 

P - PRINT INDICATOR 

P = 6 CAUSES PRINT EACH ITERATION OF STATES 
RATES, AlWD ITERATlOiNI INFORMATiOiiJ- 
P - 7 JACOBIAN MATRIX IS ALSO PRINIED EACH 
ITERATION- 

TOL - CONVERGENCE TOLERANCE. 

ITHAX - MAXIMUM NUMBER GF ITERATIONS 
IPER ~ INTERGER WORK ARRAY - LENGTH ^ N 
M “ INDICATOR THAT AJ CONTAINS INITIAL CALC- OF J 
H = i INDICATES THAT JACQSIAN HAS BEEN CALC. 

R - VECTOR OF FUNCTION VALUES FOR CURRENT VALUE D 
RMS “ ROOT MEAN SQUARE OF R 

AJ - JACOBIAN MATRIX 

B - WORK VECTOR OF DIMENSIDM H**2 + 2^N 
ERROR ~ VECTOR GIVEN RELATIVE ERROR SIZE FOR THE VARI 
NSIM “TOTAL SYSTEM ORDER (INCLUDING FROZEN STATESJ 
DESIGNED BY CLAUDE GAGNON FEB 1970 
COMM ON/CINT/ INT { 1 i /CTIME/TIHE 

DIMENSION AJ(NR,l),RCl),X(lUBCN8li,IPER{ li ,ERROR£lJ 
EXTERNAL FUN 
DATA RT,DX/0 -5, -000001/ 

INITIALIZE 

IREC=0 
IT=0 
IP=P 
IS=0 
S1=0- 
E=-l 
NS=1 

ITHX=IABStITHAX> 

IF{ITHAX-LE.0> NS=2 

COMPUTE INITIAL NORM OF X 

DO 5 i=l,N 
Sl=Sl’i'XCll**2 
5 CONTINUE 

IF(Sl-N£-0-)GQ TO 9 
DO 7 I=1,NSIM 
IF(INTm-EQ-0}GD TO 7 
S l=S 1+ERROR t I >**2 
GDNTIMUE 
Sl=Si*l-E4 

EVALUATE FUNCTION AT X 

CALL EVAL2(X,NSIM,FUN,P,RMS,R) 

ICL=1 

C — TEST FOR JACOBIAN PRINTOUT 

iF(iP-LT.6.)GQ TO 10 
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CALL LPRINTt2,TIM£J 
XFaP,NE-7)GU TO 10 
WRITEt6»1001) 

1001 FORMAT (/50X,=»=INirXAL JACOBIA^i^J^) 

DO 1005 1==1,N 

WRITt(6yi003HT{AJ(lTJJ» J=1»NE} 

1003 FCiRHAT(iX»l3,(T3,L0t2X,&i0.4)> 1 

1005 CONTINUE 
10 CONTINUE 

Q 0 j£s^X XF 1£«ITIAL JACOBIAN IS GIVEM 

IFIM-NE-Oi GO TO 33 

C INITIALIZE ARRAY OF X CHANGES 

DO 15 I=1,NSIM 
15 b(i,N+iJ=i- 

c — CALCULATE COMPLETE JACOBIAN 

20 J=0 

DO 29 J1=1,MSIH 
IF(iNT(Jl).EQ.01GD TO 29 
J=J+i 
XSAV£=XCJ} 

DELTA=SIGNtERRORtJl),B{JiTN+lJ ) 

X(JJ =^XtJ)+OELTA 

CALL EVAL2{X,NSlM,FUN,PrRHSJAC,AJ{i, J> i 

1CL=ICL+1 

X(J)=XSAV£ 

DO 30 1=1, N 

AJ(I ,J5=tAJ£I,Ji-R(I)}/D£LTA 
30 CONTINUE 
29 CONTINUE 

C 0 TEST IF PRINT OF ITERATION INFORMATION IS REQUESTED 

IFCIP-NE-71&Q TO 33 
WRITE(6,i006) 

1006 FQRMAT{/50X,=frRECALCULATED JACOBIAN^S^I 
DO 1007 1=1, 

WRlTtC6,1003)i,lAj£l,J>,J=l,Nl 

1007 CONTINUE 

C == = = ====: =====s:== MAIN ITERATION LOOP ====:==:===: = = 

33 DO 80 K=l,10 

IF S I T-^-K . GT - 1 TMX ) RETURN 
IF(RHSoLE-TOU RETURN 
STD=RMS 

C 0 FORM tf ECTOR OF RESIDUALS 

DO 35 1=1, N 
B(I,N<-2}=-R{IJ 
DO 34 J=X,N 
BU„ J)=AJtI, J) 

34 CONTINUE 

35 CONTINUE 

C SOLVE FOR CHANGE X USING- JAC0BIAP3 AND RESIDUALS 

CALL LUEQS{B,B£ i.N+lJ ,B£isN+25,IPER,N»i,N,N,N,l-E-16,IERR0R) 
C — - 0 CALCULATE NORM OF CHANGE TO X 
S2=Q« 

DO 40 1=1, N 
B(r,N+2I=R{I) 

S2=S 2+B { 1 ,N+1 } 

40 CONTINUE 

RATI0=SQRTCS2/S1I 

C CALCULATE FRACTION OF STEP TO TAKE 
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C=AHINitE/RATID»l.) 

FRAC=C 

IH=0 

F=E 

IFISIS^EQ-I) GD TO A4 

C — -r- ADJUST CHANGE VECTOR AND MAKE TRIAL STEP 

44 DO 48 1=1, N 

BtlTN+lJ=Ci=BtI,N+l} 

BCl,l)=X(n+BtI,N+l) 

48 CONTINUE 

C EVALUATE FUNCTION AT TRIAL POINT 

CALL EVAL2[B,MSIH,FUN,P,RMS,R) 

ICL=ICL+1 

C 0 iji residuals increase, go to 58 WHERE SMALLER STEP WILL BE T 

IFtRHS*GE-STDl GD TO 58 

C — 0 ACCEPT STEP, UPDATE STEP SIZE PARAMETERS 
IREC=0 
IS=^IS+1 

IFUS.LT-21 GO TO 60 
IS=0 
1 £=£+-! 

IF(TE.L£-2.) E=T£ 

GO TO 60 

C HALVE STEP SIZE 

58 C=RT 

FRAC=FRAG*RT 

IS=:0 

C ADJUST STEP SIZE PARAMETERS 

TE=£-0-05 

IFtTE,G&..09> E=TE 
IH=IH+1 

C TRY REDUCED STEP SIZE 3 TIMES 

IF{IH-LT-3l GO TO 44 

C IF FAILURE AFTER 3 TIMES, RECALCULATE JACOBIAN 

iFtlREC.EQ.DGQ 10 59 

IREC=i 

IT=XT+K“1 

CALL EVAL2(X,NSIH,FUN,P,RHS,R) 

GO TO 20 

IF STILL MO IMPROVEMENT, TAKE STEP ANYWAY TO GET AWAY FROM 
BAD POINT. 

59 IREC=0 

FRAC=FRAC*2. 

C — - TAKE STEP 

60 D=S2+FRAC=#=*2 
S2=1.-FRAC 

C UPDATE NORM OF X 

S3=0. 

DO 65 1=1, N 
XUi=BiI,l) • 

S3=S3+XCI)=4^Xa) 

Ti=R(I)”B(I,N-t'2)*S2 
DO 64 J=1,N 

C 0 MODIFY JACOBIAN VIA NEK FUNCIIQN INFORMATION 

AJtI,J)=Aja,JJ+Tl*B( J,«+1J/D 

64 CONTINUE 

65 CONTINUE 
S1=AHAX1(S1,S3) 
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J=IT+K 

C TEST FOR PRINnr REQUEST 

IF{IP«LT-6)G0 TO 70 
HRITE(6,200) J,RATIOyF,FRAC 

200 FDRMATC///1TH ITERATION NUMBERI3/67H RATIO OF LENGTH OF FULL NEWTD 
XU STEP ro LENGTH OF INITIAL VECTOR - E18-10/24H MAXIMUM ALLOWED RA 
XTIO =£I3,10TlOX,3iHFRACTION OF NEWTON STEP TAfCEN =£18-10] 
RN=RHS*RMS 
WR1T£{6,210J ICLjRN 

210 FQRHATtOOH NUMBER OF FUNCTION EVALUATIONS =14 j5X, 2 5HR£SI DUAL SUM O 
XF SQUARES =E18,10/> 

CALL LPRINT{2,1TH£) 

IFIIP.NE.7)G0 TO 70 
WRITE(6,100S1 

1008 FDRMATC/50X# ♦MODIFIED JACOSIAN*) 

DO 1009 1=1, N 

WRrTE(6,1003)I,(AJtI»J),J=lrN} 

1009 CONTINUE 
70 IFIJ-GE-ITMXJ RETURN 
DO CONTINUE 

£N0 OF ITERATION LOOP 

TEST IF ERROR IS WITHIN TOLERANCE 

IF(RMS-LE-TQL} RETURN 
IT=I T+IU 

C TEST IF NUMBER OF ITERATIONS EXCEEDS GIVEN MAXIMUM 

IF(IT-GE-ITMX) RETURN 
IF(RHS-LE-0.5=i=ST0) GO TO 33 
GO TO 20 
END 


BCS 40262-2 


143 



CRKINIT 

SUBROUTIME RKINIT 

CQMHON/CX/X{l)/CXDOT/XDOTU}/CTIHE/TXHE/CORDER/MSIHyNQVrNOP 
COHM OW/CMQRK/A ( X } /CWDRKJ#/Nf< 2 »K3 1«5 , M6 ,W7 

COMM Df^/CNTRLS/AMTY PE# X PR IM OD E , ERROR ( 1 ) 

COMHOM/CSIMUL/IPRIPi#IPRATE,IOUTTMPTS»NPTMAX,INDHAX,TiNC,TMAX 

CDHM 0N/i^RKVS3/IDIA&» AHMINM » AHSTRl , INTFLG, MA Xf4>HFAILl »Af STEP2 , ISTABE 

COH?!OM/CDIFS/JSTART#KINIT 

IDIAG“0 

AHMIS^H ~ 0, 

AHSIRT = 0- 

1NTFLG=0 

lSTABL=i 

«AXN=ldO 

HFAlLi=iO 

MSTEP2=100 

RETURJJi 

END 
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CRLBTCH 

OVER.LAY(RLBTCHyllsfO} 

PROGRAM RLBTCM 

C VERSION 3- REVISED s APRIL 3D 19 7S 

C PURPOSE CONTROL AND DISPLAY CALCULATION OF ROOT LOCUS 
COHMIWCGRDER/NSIHjNOVsNOP 
COMM ON/CPROM/DUHIC 7} , RLPAR 

COMM DN/CPR0V/DUH2 1 17 J * ST ART j STOP , ROOTS t RLSCL ( 4> 

COMM QN/COVRLY/IMST » LQKSS , LOKSIM 
CDHKON/CWORK/AU) 

COMMON /CWDRKN/NN7Ki»N2»N3,N4,N5»N6*N7 
COMMON /CXIC/XICCi }/CINT/INTCI ) 

COMMON /CNTRLS/ANTYPE,IPRli'iT»HODE, ERROR m 
CQMMON/CSMPAR/SMPARC 10) ,ICSS,ICRL 
REAL NAMEX#RLPAR,SMPAR 
COMHON/CNAMEX/NAMEXU) 

COMMON /CPLDTS/ 1NDPLT,INDWR,IQPTC30S ,PLQTXOt 5) ,PTITLE( 8) s 
+ IPOPTiiO) 

DIMENSION YOPT(l) 

EQUIVALENCE ( YOPTC 1) r IDPl t 1 J ) 

DIMENSION RLARRYCiOOOJ 

DATA ICN/10H,IC /»I8LNK/10H / 

CALL CODGEN CRLPAR, ICRL,IPARAMJ ?RtTURNS{4000) 

ICX=IBLMK 

IF(ICRL-EQ«1) ICX^ICN 
C PRINT DERCAL ARRAY 
IDPTC3) = IBLNK. 

IDPTt4) = IBLNK 
CALL DTTIM {IQPTC3)) 

IF(INST-£Q,35)G0 TO 2820 

WRITE £t»,2809) PTnLE,XQPT£3 ) * IDPTC41 , 

+ (l,NAHEX{iJ tXIC[n,£RROR{I),INT£IJ 9 l=l,?«SIM] 

2S09 FORHAT(30X,30H/=fr/*/4:/ ROOT LOCUS // 

2 26X,SAi0//54X,2A12// 

17X,5HSTAT£s&Xr*0PERATrNG PERTURBATION INTEGRATOR* 

2/8X , *NAME* , 8X ,* POINT* j 9X ,*SI 2E*f 8X ,*CONTRDL*/ 

2 £I5,1X,A10,G14o59G12-3sI91) 

C IN1TIALX2E STABILITY MATRIX CALCULATION MODE INDICATOR 
ITEST=0 
GO TO 2B30 

Q — SET MODE INDICATOR TO PREVENT RECALCULATION OF A MATRIX 

2820 ITEST=3 

C INITIALIZE ROOT LOCUS DISPLAY ARRAY INDEX 
2330 IND£X=1 

C INITIALIZE AUTOMATIC SCALE RANGE PARAMETERS 
XHIN=1.E36 
XHAX=-1.L36 
YHIN=1-E36 
YMAX--1-E36 

CALL VAROUT Cl PARAM, PARAMO) 

DELTA=0* 

NRQDTS=ROOTS 

IFtNROOTSoGT-i) DELTA={ STDP-STARTi/tNROOTS-i) 

C TEST TO PREVENT START FROM EQUALLING NOMINAL VALUE 

IF t START-EQ - PARAMO) START =PARAMO-»- DELTA 
C PARAMETER SCAN VALUE 
2850 PARAM=START 
C ROOTINGS COUNTER 
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K0UNT=0 

lF{IWDEX-GT-1.0R-PARAH0-EQ.0,i GO TO 2860 

K0UNT=“1 

PARAH=PARAHO 

2S60 CALL VARMDDtiPARAMrPARAM} 

C SAVE PARAMETER VALUE 

RLARRY ( INDEX +1 } =PARAM 
C DETERMIHE PLOT SYMBOL INDICATOR 
SYMB=5« 

IF (PARAH-EQ. PARAMO i SYMB-6. 

IFCPARAM-EQ.Q) SYMB-7^ 

C STORE SYMBOL INDICATOR IN DISPLAY ARRAY 
RLARRY(INDEX+2)=SYHB 

C SAVE INDEX FDR STARTING POINT OF CURRENT SET OF ROOTS 
INDEXS=1NDEX 

C PRINT PARAMETER INDICATOR AND ROOTS 
HRITE(6,Z3S0) RLPAR,ICX,PARAM 
2880 FDRHAT<//22X,A8.A4,,3H = ,Gi2.6> 

IF{PARAM-EQ-PARAH0J WRITE( 6, 2882} 

2882 FORMAT NOMINAL VALUE=4^) 

CALL RDTCALlNSIMr INDEX, ITEST , RLARRY,XMIN, XHAX ,YMIN,YMAX 

1 A,AtNN),A£Nl)i.ACN2>,A£N3) ,AtN4l,A(N5i,A(N2}, AtN3) rA£N4},A{N5) 

2 AtNDJ 

C CAUSE ITEST TO TAKE ON VALUES 0,2, 3,3, w. * . • 

IFiITEST.EQ,2) ITEST=3 
IFdTEST.cQ-Oi ITEST-2 
2975 IF£K0UNT-L£«“1J GO TO 2850 
C ADVANCE ROOTING COUNTER 
K0UNT=K0UNT+1 

IFlKOUNT-GE.NROOTSi GO TO 3020 
PARA M=P ARAM+DELT A 
GO TO 2860 

C RESTORE PARAMETER TO NOMINAL VALUE 
3020 CALL VARMQD£lPARAM,PARAMOI 

SET PLOT PARAMETERS - 

IF C INDPLT .EQ* 0 } GO TO 6000 
IDPTCIi - 3 
I0PT(2} = 10PT£2) +1 
YDPTT5) = RLPAR 
DO 150 I=6,il 
150 YOPT£i) = G.O 

IF ( IPOPTU) .EQ. 0 ) GO TO 200 
YOPTC 6) = RLSCLCIJ 
YORK 7) - RLSCLU) 

YOPT£ 9) = RLSCL£3J 
YOPTClOl = RLSCLC4) 

200 CONTINUE 

NPTS = INDEX-1 
lOPTtlZ} = MPTS 
WRITE £30} IDPT,PLDTID,PTITLE 
WRITE £30) {RLARRYID ,I-1,NPTSI 
INDWR - i 
WRlTEt 6,4011) 

4011 FORMAT!///// ) 

GO TO 6000 

4000 WRITE £6, 4001) RLPAR, ICX 
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4001 FORMAT l//10Xy31H*** WARNING IDENTIFY? IX, A8yA4 9 IX 

1 31HAS A VALID ROOT LOCUS PARAMETER//) 

HRITECStAOII) 

600ffl CONTINUE 
END 
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CRQTCAL 

SUBROUTINE ROTCAL£NSlMrINDEXrlTEST,RLARRyrXHIN»XHAX*YMINtYHAX, 

1 At R ATID » DWQRKf IA,IB,IC,IDrEVR,EVIyWN, DAMPR , XDOTQ } 

VERSION 2- revised: OCT 5 1976 

PURPOSE— CALCULATE STABILITY MATRIX AND IT^^S EIGENVALUES AND RETURN 
ALL EIGENVALUES WITH IMAGINARY PARTS >-0. 

CALL SEQUEKCt 

NSIM = TOTAL NONLINEAR SYSTEM ORDER. 

IJ4DEX = STARTING LOCATION If# ARRAY RLARRY FOR RETURNED DATA. 

ITEST = INDICATOR FOR MODE OF DPERATIO£4 FOR STABMX ROUTINE. 

{THIS MUST BE 0,2, OR 31 
RLARRY = ARRAY OF ROOT LOCUS DATA. 

FIRST WORD = iNO- OF POLES 
SECOND WORD = PARAMETER VALUE 
THIRD WORD = SYMBOL DESIGNATOR 

NEXT N WORDS = REAL PARTS OF POLES IN ~ NO- OF POLES) 

NEXT N WORDS = IMAGINARY PARTS OF POLES 
THIS PATTERN IS REPEATED FOR EACH SET OF POLES 
LIMITATIONS 

1. THE DIMENSION OF THE LOCAL ARRAY UK LIMITS THE MAXIMUM ?^H6ER 
OF ELEMENTS OF A THAT CAN BE EFFECTED BY A ROOT LOCUS PARAMETER 
TO AOO. IF MORE ELEMENTS ARE EFFECTED, A SLOWER METHOD IS USED 
TO CALCULATE A. 

2. ICQUNT + UK ARE LOCAL VARIABLES THAT ARE REQ^D ON SUBSEQUENT 
CALLS, THUS PRECLUDING OVERLAYIifijG THIS ROUTINE DURING ROOT LOCUS 
CALCULATIONS - 

DIMENSION RLARRY Cl >,IJK( 400) 

DIMENSION tVRUl ,I All J, IBID, lCtl),IDtl iyXOCTO til, DWORKf 1) 
DIMENSION EV1{1),A£1),RATI0C1) 

DIMENSION WNl 1) , DAMPR m 

DATA IP0H/4H•l~^-/,I6LNK/4H / ^ 

C CALCULATE STABILITY MATRIX r: 

CALL STABHXlNSIM#XOaTa,ICOUNT,IJK,A,NLIN,ITESr) 

C CALCULATE EIGENVALUES 

CALL EGVL31A,RATI0,EVR,EVI,IA,IB,IC,ID,DW0RK, l.E-14,NLIN,NLIN) 
CALL NATFRQ I EVR, EVi ,WN, DAMPR, NLIN,NPQLES ) 

C STORE NO. OF POLES 

RLARRYC INDEX ) =WPOLES 

C INITIALIZE REAL + IMAGINARY PART INDICES 
IR=IND£X+3 
II-IR+NPOLES 
WRITE(6,2B67) NLIlH 

2867 FDRMATC/ 2SX,I3,2X,*EIGENVALUES=4'/13X,*REAL=4=,9X,*IMAGINARY*, 

1 6X,*NATURAL FREQ.*, 5X, ♦DAM PING RATIO*) 

C STORE REAL -t- IMAGINARY PARTS OF POLES 
DO 200 I=I,NiPDLES 
DUK=EVRU) 

RLARRY UR 1=DUM ^ 

1R=1R-U <5 

IFCDUM-LT-XHIN) XHIN=DUM 
IFCDUM-GT.XMAX) XHAX=DUM 
DUM^EVItl) 

RLARRYC II )=DUH 
11 = 11+1 

IFCDUH.LT.YMIN) YHIN=DUM 
IFCDUM-GT.YMAX) YMAX=DUM 
J=IBLNK 

IFC6VI(I1-GT=0-J J=IPOM 
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2S6S WRn£C6f2B69)Ii-£VRUl,J,EVXaJ ,WN£1) 
2669 F0RHAtC3XTl3,3X,Gi2,6,2X,A2,GI2.6,4X 
200 COWINUE 
INDEX=II 
RETURN 
EJ«D 


DAMPR(I) 

2 & 16 - 6 } 
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C SCALE 

Sl/BROUTIfiE SCALElATT,ji«,H) 

SUBROUTINE TO SCALE AN IRREDUCIBLE HATRiX A. 

T IS AN « DIMENSIONAL VECTOR CONTAINING TKE DIAGONAL 
COMPONENTS OF THE TRANSFORMATION MATRIX 
N IS THE ORDER OF A 
H IS THE ROW DlMENSlOi*^ OF A 

THIS PROGRAM WAS DESIGNED AND CODED BY A» FREDERICK FATH OF 
BOEING COMPUTER SERVICES^ SEATTLE, WASHINGTON, THIS VERSION 
WAS COMPLETED DURING APRIL 1975. 

DIMENSION A{.Mt1},TU) 

Ni=Nl-l 
1T=0 

DO 5 1=^1, N 

5 1(1} =1, 

6 IT=IT+1 
IF(IT,GE-!NJ go to 40 
TMI=0, 

C FORM ROW AND COLUMN E-NDRMS 

DD SO K=1,N 
SR=0. 

SS=0. 

00 iO J=1,N 
1F(J,EQ,K} GO TO iO 
SS=SS-i-AC 
SR-SR+ACK,J)*=S=2 
10 CONTINUE 

SS-SQRT(SS/SR3 

C DETERMINE COMPONENT MULTIPLIER 

TM=SQRTCSSJ 

lF(ABSITM~l,).GT,TMi} TMI=ABS (TM-1. J 
C ADJUST A MATRIX AND TRANSFORMATION T 

IFtK~NJ 12,20,20 
12 T{K)=T4K.)«TM 

DO 15 J=1,N 
IFCJ-EQ-KJ GO TO 15 
A(K, J)=A(K,JJ *TM 
AIJ,KJ=A( J,K)/TM 
15 CONTINUE 

GO TO 30 

20 DO 22 J=1,N1 

22 T(J)=TCJ)/TM 

DO 25 1=1, N1 
A{I,N)=AS I,N}/TH 
25 A{N,I>=AEN,I)=i^TM 

30 CONTINUE 

IFdMI.GT.-i) GO TO 6 

40 CONTINUE 

RETURN 
END 
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SUBROUTINE S£TIN{I,VARlJ 

C PURPOSE: TO MODIFY THE CURRENT VALUE OF A STATE VARIABLE, PARAMETER, 

C ETC- AND TO EXECUTE THE MODEL TO OBSERVE THE RESULTS OF 

C THE MODIFICATION. 

G CALL SEQUENCES 1 == IDENTIFICATION CODE- 

C VAR = NEW NUMERIC VALUE OF QUANTITY IDENTIFIED BY COD 

COMMON/CX/Xa )/CXDOT/XDOT{ D/CV/VCl J /CP/P( 1 J/CXIC/XICUJ 

cqmmon/ctime/time 

C TEST FOR TIME 

IFII-NE.OJ GO TO 10 
TIME=VAR 

5 CALL £QMOtO-,0-,0) 

RETURN 

C TEST FOR STATES 

10 IFfI-LT-l-OR.I.GT-1000000) GO TO EG 

X(I)=VAR 
GO TO 5 

C TEST FDR VARIABLES 

ZO IFtI-LE-300000a.DR.I-GT.4000000) GO TO 30 

J=I“3000000 
VCJI^VAR 

CALL VARSET(0-,0., J) 

RETURN 

C TEST FOR RATES 

30 IF(I-LE.10QOOOO-DR-I-GT-200000Q) GO TO 40 

J=I- 1000000 
XDOT(U)-VAR 
CALL RATSETtO-,Q-,J) 

RETURN 

C TEST FOR PARAMETERS 

40 IFtI-LE«4000000-OR-I-GT. 5000000) RETURN 

P{I"400QOO0)=VAR 
GO TO 5 
END 
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CSHELLX 

SUBROUTINE SH£LLX{DARRAY,KEY»NJ 
purpose: reorder ELEMENTS OF SINGLE DIMENSION ARRAY 

BASED ON THE INIDEX ARRAY KEY. 

CALL SEQUENCES DARRAY ~ ARRAY TO BE REORDERED 

KEY - INDEX ARRAY 

N " NUMBER OF ELEMENTS IN ARRAY 

DIMENSION DARRAY{1)#KEYC1> 

IFIRST=i 

10 DO 20 I=lFIRST,ai 
IF(KEYill ) 20, 20, 40 
20 CDNTiWUb 
DO 30 I-1,N 
30 KEYtI)=-KEy(I) 

RETURN 
40 IFIRST^I 

TEMP=DARRAYUJ 
GO TO 60 

50 DARRAYtXJ=DARRAY(lKJ 
I=^IK 

60 IK=KEY(I) 

KEY(Ii=-IK 

IF(IK~IFIRSn50,70,50 
70 DARRAVtD-TEMP 
GO TO 10 
END 
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CSIBTCH 

0 VER LA y { S IB TCH , 4, 0 ) 

PROGRAM SIBTCH 

C VERSION 3-1 REVISEQS OCT 7 1976 

CQMM OM/CORDER/NS IH V eNQP 

COMM OM/C PRO V/OUMIC S ) r AH0DErD0M2 CIS i 

COMMON /CX/X( IJ/CXDOT/XDQKli/CINT/XNTUJ/CXIC/XICaJ 
COMMON /CNTRLS/ANTyPErIPRIMT,IMODE,ERROR(l) 

COMMON /CSIMUL/I PRIN,IPRATE, lOUTsNPTS ,NPTMAX, INDMAX^TINC rTMAX 
1 rINDEX,lPLDT,rDENT(4) 

COMMOJi/CPRINT/PRTMAM(10>,LPRT( 10 J>^CDIFS/JSTART?KINIT,TP 
REAL IDENT 

COMM ON/CTIME/TIME/ERME SS/IFATA L, I ERR 
COMMON /CMORK/ DSPLYU) 

COMMON /CSCALE/ SCALED 5, 4»S) ,NVAR1 5 ,2,6) jNPLTS { 6? 

COMMON /CPLOTS/ INDPLT,INDHRjI0PTI30),PL0TlD( 5),PTITL£{ 6), 

+ iPQPTUOl 

DIMENlSlQN IVARC5,2,6i,IVRC0Dl3lJ 
DIMENSION VRCODOl) 

DATA IBLK /lOH / 

IMODE-AMODE 
IPLOT-l 
1C0LFNT=Q 
DO 5 I=i,31 
5 VRCDDCi) = f'-O 
IQPTC3) = iSLK 
I0PT(4> = IBLK 
CALL DTTIM (lOPTU)) 

I0PT(2)^I0PT(2I+1 

WRITE{6,270S)1PRATE,IQUT,IM0DE,TINC,TMAX,PT1TLE,(I0PTCIJ ,1=2,4) 
2706 FORMAT (45X,41H/*/*X=»=/ SIMULATION ANALYSIS /^/^/^/ //20X? 

1 IIHPRINT RATE=,I3,3X?13HDISPLAY RATE=,I3,3X, 5HM0DE=, 

2 13, 3X, 5HTINC=, G12-5,3X, 5HTMAX=, G12.5//2&Xs8A10// 

3 15X,*CASE N0-^,I4,27X,2A12/J 
IPOUT=I OUT^IP RATE 
iPRCNT=0 
INDEX=1 
ISET=0 

IF ( INOPLT -£D- 0 } GO TO 67 

FIND CODE NUMBERS FOR THIS SIMULATION- 

NVAR ~ PARAMETER NAMES FOR EACH PLOT 
IVAR - POINTERS INTO IVRCOD FOR EACH PARAMETER 
IVRCOO -UNIQUE CODE NUMBERS USED IN THIS SIMULATION 

NCODES =1 
NOI SP = 0 
IVRCOD(l) = Q 
DQ 65 J=l,6 
IMAX = NPLTSU) 

IF { IMAX .EQ. 0 ) GO TO 65 
NDISP = J 
DO 60 1=1, IMAX 

CALL CODGB^ (NVARC I, i,J ) ,0,IV1) , RETURNSIXO) 

10 CALL CQO&ai £NVAR( I,2,J> ,0,IV2) , RETURNS £201 
20 CONTINUE 

DO 30 K=l, NCODES 
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IF ( IVR.CQD(K) IVl i GO TO 30 

IVARXI.i^JJ K 
&0 TO 40 
30 CONTINUE 

NCODES = NCODES ‘► I 
IVRC DO (N CODES 1= IVi 
IVARII,1 tJ) = NCODES 
40 CONTINUE 

DO 50 K^XtNCODES 

IF ( IVRCODCKJ .NE. XV2 ) GO TO 50 
IVAR(I*2,J) = K 
GO TO SO 
50 CONTINUE 

NCDDES = NCODES + 1 
IVRCOD(NCODES) = IV2 
IVAR{I,2,4) = NCODES 
60 CONTINUE 
65 CONTINUE 
67 CONTINUE 

INlTiALIIE FOR SIMULATION 

DO 70 I-i,NSlM 
X[I)=XXC(i) 

70 XD0T(IJ=0, 

JSTART=0 

KINIT=0 

TURN ON ERROR MESSAGES IN MODEL 

IERR=X 

CALL EQMO(TIME,TKAX,ISETJ 

™ TURN OFF ERROR MESSAGES IN MODEL 

IERR=0 

IF ( I PRIM - GT.O ) CALL LPRINTt 1 PRIN» TIME ) 

IF ( INQPLT .EQ. 0 ) GO TO 77 
DO 75 K=l, NCODES 

CALL VARDUT ( IVRCODC K) » VRCODCK ) ) 

75 CONT INUE 

WRITE C25) VRCOD 
77 CONTINUE 

INCREMENT COUNTERS AND SAVE PARAMETER VALUES IF REQUIRED. 

80 CALL STEP 1( TIME, TINC) 

ICDUNT=IC0UNT+1 
IPRCNT=IPRCNT+1 
IFdCaUNT-LT-IOUTI GO TO 130 
IC0UNT=:O 

IF ( INDPLT .£Q. 0 J GO TO 105 
INDEX=INDEX-M 
DO XOO K-1,NC0D£S 
CALL VARGUT UVRCOOCK) , VRCODCK I X 
100 CONTINUE 

WRITE (25) VRCOD 
i05 CONTINUE 

IFdPRCNT.LT.IPOUTJ GO TO 130 
IPRCNT-0 

IF t IPRIN -GT. 0 J CALL LPRINT CIPRIN,TIME) 

GO TO 130 
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110 C0f4TINU£ 

WRITE (6,1E0) 

120 FORM M X///1H , ,7HMARMIHG* 10aH=^=),66H THE f4UHBER OF DATA P 
+OI^iTS EXCEEDS AVAILABLE STORAGE FOR 0>i£ »2QtlH=4‘}// 

+ 2aX,A0H THE DATA TO THIS PQINiT MILL BE PLOTTED-///) 

INDEX = INDEX - 1 
GO TO 140 
130 CONTINUE 

IFtTIME-LT-THAX --OGOOl) GO TO 80 
140 CONTINUE 

WRITE t6s 2941) 

2941 FORMAT I/////) 

WRITE PLOT DATA- 

IF ( INOPLT -EQ- 0 ) GO TO 200 
iOPTtl) = 2 
lOPTtS) = NDISP 
DO 150 I=1,N0ISP 
IDPT(5 I) = NPLTSSI) 

150 CONTINUE 

I0PTU2) = INDEX 
IDPTUB} = NCODES 
I0PTU4) = iP0PT(2) 

IQPT(15) = NWDRK 
WRITE {30) lOPTyPLOTIDtPTITLE 
WRITE 130) SCALEjNVAR,IVAR 
REWIND 25 
DO 180 I=l,IflOEX 
READ {251 VRCQD 
WRITE (30) VRCQD 
180 CONTINUE 
REWIND 25 
INDHR = 1 
200 CONTINUE 
END 
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SUSRQUTl^lE SLVEQ { A,B,C, lA FPZ, lERRGR} 

C SOLVES A*B=C WHEN LUEQS HAS ALREADY BEEN CALLED FOR THE GIVEN A 

C A AND lA MUST B£ THE SAME AS RETURNED FROM THE PREVIOUS CALL- 

DIMENSION A(MAri}»a£MA,i),C(MC,l) srlA(l) 

IERR0R=0 
atR=FPZ*5G- 
IFtN3.EQ-0) RETURN 
NA1=NA-1 

C PERMUTE ROWS OF C 

DO 70 I=1,NA 
K-IACIJ 
DO 70 J=1»NB 
70 ii£ly J)=C(K,Ji 

IF(NA.LE.I) GO TO 76 
C SOLVE FORWARD SUBSTITUTION 

DO 73 
DO 75 

SUM=&£I,J) 

Sa=ABStSUMJ 
IK =^1-1 

DO 74 K=X,IK 
SA=A(I,KJ*B£K,JJ 
IFtABS{SAJ-GT-SB} SB=ABS<SA) 

74 SUM^SUM-SA 

IF(ASStSUM) -LT-EftR*SSi SUM-0- 

75 B£I»J)=SUM 

C SOLVE BACK SUSSTITUTION 

76 DO 77 J=1,NB 
B(NATJJ=b{NATJ)*A(NAsNA) 

77 CONTINUE 
XF(NA-LE-iJ RETURN 
DO 64 1=1, MAI 
J=NA-I 

J1=J+1 

DO 64 K=1,NB 
SUH=B(J7K) 

SB=ASS£SUM) 

DO 62 L=J1,NA 
SA=A{J,U=^=8(L,KJ 
IF{ABS{SA].&T-SB} S8=ABS(SA) 

62 SUM=SUM~SA 

IF(ABS£SUMJ-LT-£RR*SB) SUM=0- 
64 8(J,K}=SUM*At J, J) 

RETURN 

END 
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CSHBTCH 

C*VERLAy{SHBTCH,6T0) 

PROGRAM SMBTCH 

C VERSIOM 2- REVISEDs DEC 8 1975 

, C PURPOSES CONTROL STABILITY MARGIN CALCULATION 
j COMHON/CORDER/NSIH,NOV,«OP 

I COMMON/CSMPAR/PARAK[10),ICIND12) 

j COMMON /CXIC/XICCl )/CINT/INTSl ) 

I COMMON /CNTRLS/ ANTYPEjIPRmr, MOD E» ERROR MI 

; COMM ON/CNAM EX/M AMEXil) 

COMMON /CWORK/Atl) 

‘ COMMOS /CWDRKN/NN,NlfN2,N3,N4ffN5jN6sN[7 

DIMENSION LXCHilOJ ,GHDSPY150} 

IP0LE=:0 

Ki=0 

C. ~=::s:===” generate CODES CDRRESPOMOING TO SM PARAMETERS 
DO 2820 1=1, iO 

CALL CODGBIIPARAHCI) ?0,LICKUntRETURNS{28I0l 
IFiLICHM)*LT-iJ GO TO 2830 
i GO TO 2815 

! 2810 WRITE(6,2Sll)PARAMtII 

2811 FQRMATC///10X,31H=f'=^^=J= WARNING CAN^J^T IDENTIFY, iX, AS, IX, 

i 38HAS A YALID STABILITY MARGIN PARAMETER//) 

2815 Ki=Kl+l 
' 2820 CONTINUE 

2630 CONTINUE 

IFCKI.LE.OJ GO TO 2930 
WRITEt6,29Xa) {PARAHtII,I=l,Kl) 

i 29L8 FORHATtiHl /5 OX, ?H/4=/+/4:/,3 Xt=«^ST ABILITY MARGIN ANALYSIS*, 3X , 
17H/*/*/^///10Xt]l 4HF0R PARAMETERS ,3X, lOA ID 
WRITE{6,28D9) (I,NAM£XUJ ,XIC (1 3 , ERROR! I ) ,INTt 1 1 , 1 = 1, NSIM J 
I 2809 FORHATC/ 

I 17X,5HSTATE,6X,*0PERATING PERTURBATION INTEGRATOR* 

i 2/SXT*NAH£*,BX,*POINT*,9X,*SIZt*,8X,*CONTROL*/ 

I 2 M5,lX,AiO,G14.5,&i2«3,I9H 

I c =--=—==== CALCULATE STABILITY MARGINS 

2920 CALL GANMAR ENSIM, LICH,PARAH,K1,IP0L£,GMDSPY,A,A { NNl , AtNl ) , 

1 A{N2},A(J«31 ,ACM4),AtN5I ,A(N6) ,A(N2) ,A(N3) ,A{NU ,AEN4) }, 

; 1 RETURNS (300©) 

! WRIT t(6, 2921) 

j 2921 FORMAT (///, 2 8X,*SUMM ARY OF STABILITY MARGIN STUDY*/ 

1 92H PARAMETER NOMINAL VALUE LOWER MARGIN LOWER FREQ. 
I 2 UPPER MARGIN UPPER FREQ, ) 

’ WRITE{6,2923) (PARAMU) , (&HDSPY(I+(J-I)*KL) ,J=I,51, 

1 1=1 ,K1) 

2923 FQRHAT(2X,A8,4X,&i3-4,9G17.4J 

2930 WRITE (6,2931) 

2931 format (/////) 

GO TO 6000 

3000 GO TO 2920 
6000 CONTINUE 
END 
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OVER LAY (SSBTCHt iO#0 ) 

PROGRAM SSBTC 

C PURPOSES PROVIDE OVERLAY INTERFACE TO PASS WORK STORAGE 
C AREAS TO STEADY STATE ROUTINE SSBTCH 

C DESIGNED BYs J.D, BURROUGHS FE& 1974 

COMMON/CWORK/AU ) 

CDMMON/CQVRUY/INSTtLOKSS tLOKSIH 
COMHCa/CCRDER/NSlM ,NOV,^iaP 
CQMMON/CPRQN/DUMK6) ,INDEP,DUM2 

CDHMD*</CPR0V/DUM3(5 ) ,PRlNTfDUM4{7J ,XSTARTf XSTQP , POINTS, LIMIT? 

1 OUHStBl 

COMMON /CWDRKN/NN,NlTN2ifN3,N4,N5,N6,N7 
REAL INIDEP 

CALL SSBTCH [INDEP,XSTART,XSTQP,POlS<TS, LIMIT, NSlMjPRlNT? 

1 A,A (NN1 ,A,A(N1J ,A{N2J , A (N3) , A(N4) ,A IPJfS) ,A(N2J ,A m3) ,AtNl ) ? A1N4) , 

2 A(N5J,AlN6)),RETURNSii00) 

LDKSS^i 

GO TO 6000 
100 LDKSS=0 
6000 CONTINUE 
END 
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CSSBTCH 

SUBROUTIHE SSBTCHJ INDEPyXSTART, XSTQP, POINTS tLIfiII»NSIHyPRIWTT 
1 A# RATIO , DSP LY» DWORK? I As XB* IC, ID »EVR 9 EVI r XDOTO 9 WN , DAMPR, XICSA V i j 
Z RETURNS (Rl> 

VERSION 3.2 revised; OCT 8 1976 

PURPOSE; CONTROL CALCULATION AND DATA DISPLAY POR STEADY 
STATE ANALYSIS. 

CALL sequence; IWDEP - SS PARAMETER (HOLLERITH NAME) 


LOCATION 
/CWORK./AE1) 

/CWQRK /ACNNJ 
/CW0RK7A(1J (NOT USED) 
/CWQRR/ACNll 
/CWORK/ACNXJ 
/CWORK/A £M3) 

/CWORK/A CNAJ 
/CW;jRK/AtI«5) 

/CHQRK/A1N2) 

/CWORK/A (N3) 

/CVraRK/AtNIJ 

/CWORK/A £N4) 

/CWORK/A f,N5) 

/CWORK/A (N6J 

RETURN Ri RETURN TAKEN IF SYSTEM IS UTJSTABLE 

DESIGNED BYs J-D« BURROUGHS FEB 197A 

VERSIOM 2. revised; sept iO 1975 

EXTERNAL EQMO 

COMM ON /CX/X i 1> /CXDOT/XD QT ( 1 1/CINT/INT ( IJ /CXIC/X IC £ 1 ) 

COMMON /GNTRLS/ANT YPE » IPRINT*IHD DE , ERROR £ 1 S 

CQMHQN/CNAMEX/NAHEXU J/CNAMER/NAHER(1> 02 

COMMON /CSIMUL/I PRIN , I PRATE , IDUT ? NPTS ,N PTMAX „ INDMAX r TING 5 TH AX 
1 9lNDEXsIPL0T»IDENT£4i 
COMMON/CTIME/TIHE 
COHMON/CPRINT/PRTNAMdOJ ,LPRT£ 10 J 
COMM DN/CSHPAR/SMPARUO J » less » ICRL 
COMMON /CSCALE/ SCALc{5r4»6) »NVAR( 5 ,2, 6 ) ,NPLTS I 6 J 
COMMON /CPLOTS/ INDPLTtINDWR,I0PT£3O1 9 pLOTXD£ 5),PTITLEt 8 ), 

+ IPOPTSIO) 

DIMENSION DSPLYCl) 

DIMENSION IVAR£552,6),IVRCQD131J 
DIMENPION NVRDMY( 5f2r6) 

REAL fi;'VAR,NVRDMY 
DIMENS::D?J SSAVE£31) 

dimension OWQRKC iJ ,IA£ U ,I& £1} ,IC£1) ,A£ 1) sRATXOS II ,XlCSAV«iJ , 

1 ID£l3,EVR£Xr,EVl£l),XDQTOii>,WN£lUOAMPRm 
REAL NAMEXyNAMER ,INDEP»SMPAR 
REAL LIMIT 

DATA ICN/4HyIC /jIBLNK/lOH /yIPOH/lOH-fi— 1 — -i— t— +-/ 

REHIfiD 25 

======:=: generate COOES FOR PLOTTED QUANTITIES 

DETERMINE CODE OF STEADY STATE PARAMETER 
CALL COOGENt INDEPylCSSylND J sRETURNSCA-lOOI 


XSTART - SS START 
XSTOP - SS STOP 
POINTS - SS POINTS 
LIMIT - SS ITERATIONS 
NSIH - MODEL ORDER 
PRIsNT “ PRINT CONTROL 
NAME DlME?«SIOff 

A - NSIH X NSIH 

RATIO - NSIM X NSIH 

DSPLY -NSIH X NSIH 
DWQRK “ NS IM X 1 

XA “ NSIH X 3L 

IB - NSIM X 1 

iC - NSIM X 1 

ID - NSIM X 1 

EVR " NSIM X 1 

EVI - NSIM X 1 

XDOTO “NSIM X 1 
WN “ NSIM X 1 

DAMPR - NSIM X 1 

XICSAV “ NSIM X 1 
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IMDEX=Q 


c =:==;:=t=:=r;r==::= IF MO STEADY STATE PARAMETER, SKIP PLOTHWG 
IF ( IND-LT^O > GO TO TO 
G FIMD CODE MUM3ERS FOR THIS STEADY STATE 


NVAR ^ PARAMETER NAMES FOR EACH PLOT 
IVAR - POINTERS INTO IVRLQD FOR EACH PARAMETER 
IVRCOD - US*^IQU£ CODE LUMBERS USED IM THIS SIMULATION 

MCG DES - 1 
NDISP = 0 
IVRCODU} = IND 
DO 65 J=i,6 
IMAX - NPLTStJ) 

IF t IMAX .£Q. 0 > GO TO 65 
NDISP = J 
DO 60 1=1, IMAX 

CALL CODGEN (MVARl I , I, J ) ,0, IVl) , RETURNS ( 20 J 
20 CONTINUE 

DO 30 K=1,NCDDES 

IF ( IVRCOD(K) -ME- IVl > GO TO 30 
IVAR{X,1,J) = K 
GO TO 40 
30 CONTINUE 

NCODES = NCODtS I 
IVRCOD tN CODES) = IVl 
IVAR(IrI»JJ - NCODES 
40 CONTINUE 

IVARII,2,J> = 1 
60 CONTINUE 
65 CONTINUE 
70 CONTINUE 

========;::= GENERATE LINEAR STABILITY MATRIX 

CALL STA BMX ( NSIM , XDOTO , I COUNT , RA TIO , A , N LIN , 0 J 

C ====“=== CONVERT PRINT CONTROL TO INTEGER 
2160 lPRrNT= PRINT 

C ===:=:==== SET OUTPUT AND LIMIT CONTROLS 
IPRIN IvPRlNT 
ITLIM=i.FiXlLIHIT) 

IF{P0INTS-LT-2-) P0INTS=2- 
IP0INT=1FIX t POINTS ) 

IF C I POINT- GT -IN DHAX J I PO INT=i NDM AX 

C ======^s== SAVE INITIAL OPERATING POINT 

CALL XFRtXIC,XIGSAV,NSIM) 

IFClND-GE-0) GO TO 2168 

C ===;=-—=-= PRINT TITLE IF NO SS PARAMETER WAS GIVEN 
WRIT£(6,2166)1TLIH 

2166 FDRMATUHI /30X,7H/=«^/*/#/,3X, ♦STEADY STATE AMALYSIS#,3X>,7H/*/^/«/ 
1//30X,*A MAXIMUM OF ♦,I4,* ITERATIONS CAN BE USED*/) 

GO TO 310Q 
2168 ICX=IBLNK 

IQPTC2)=IQPT(2)+1 

C =====i===:= test if SS PARAMETER IS STATE 
IF{ICSS-EQ.I) ICX=ICN 
I0PTC3) = IBLNK 
IDPTt4) = IBLNK 
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CALL DTTIM UOPTfS}) 

C ====-:=== PRINT TITLE WITH SS PARAMETER 

WR ITE{ 6 , 2170 HNDEP , iCX fXSTART? XSTQP , I ILIM, PtITLE y lOPT £ 2> , lOPT C 3) , 
1 10P1:£4} 

2170 F0RMATt43Xy4XH/*t=/^/^f=/ STEADY STATE ANALYSIS 

1 //3 OX ySH VARIED jASyA4,5HFRQM '/&10.4,4H TO 5010-4, 

2 4 X 5 '^'A MAXIMUM OF «,I4, 

3 * iterations can be used per ANALYSIS4://26X*8A10// 

4 l5X?^CASe N0.*,I4,27X,2A12J 
1150 DELT A=£ XSTQP-XS TART 3 /fi IPO lNT-1) 

INDEX=1 
IPLOT=i 
PARAH=XSTART 
CALL VARDUTdNDyPARSAVJ 
3000 CALL VARMODClMDsPARAHJ 
DO 3020 I^isNSlM 

3020 xa)=xicti) 

WRlTEt6,3050] IND£P,ICX, PARAM 
3050 FDRMAT(4H0 ,A8 5A4,3H = ,012-6) 


C =„====;= SET STEADY STATE CALCULATION FLAS = I CSUCCESS3 
3100 ISS=1 
3120 P=iPRlNT 

XTMAX=-IA8StITLiM3 

C =====r^=^ CALCULATE INITIAL JACOttlAN OF SYSTEM 

IFilNDEX.GT.DCALL STADHXtNSlMsXDOTO, ICOUNTyRATIOyAyNLlN ,0) 
C s====^== TRANSFER X TO DAMPR AND COMPRESS OUT FROZEN STATES 
J=0 

DO 3J3-0 1=15NS1H 
IF{INT£X).£Q-0JG0 TO 3130 

DAHPRt J)=X(I) 


3130 CONTINUE 

C ==-^===== CALL NONLINEAR SIMULTANEOUS EQUATION SOLVER 

CALL QNWI2I DAMPR ,NLlW,NLlRStf EQMO, P, -OCO 1, ITMAXylCsl , IB 5 RHS ,A 5 
1 RATIO, ERROR, NS IMJ 

C ===t===-=:== TRANSFER STEADY STATE TO STATE VECTOR X AND UNCOMPRESS 
0^0 

00 3145 I=1,NSIM 
IFUNTtI) .EQ.03G0 TO 3140 
J=J+1 

XCIJ=^OAHPRtJJ 
GO TO 3145 

3140 XU) =XICSAV{i) 

3145 CONTINUE 

C =:==“= test for SUCCESSFUL STEADY STATE CALCULATION 
IF(P-NE-“I)GO TO 3170 

c ==;====: SET STEADY STATE FLAG = 0 (FAILURE) 

3150 ISS=0 

WRIT£(6,3160) 

3160 F0RMAT£/5Xpi5H=t=^’f= HARMING *=f==S^55X ,*C0NVERGENCE CRITERIA NOT SATISFI 
lED, SOLUTION HAY BE INVALID^/) 

GO TO 4000 

C test if SS PARAMETER WAS SPECIFIED 

3170 IFUWfD.LT-O) GO TO 4000 

IF(ITLIM.EQ-O) IWQEX=IP0INT 

c ===^^===: test to assure that rates are printed 

IFaPRIWT.EQ«51CALL LPRlNK 2,TIME5 
CALL LPRlMTCIPRIii^TsTlME) 


BCS 40262-2 


161 


u o o 


c SAVE PLOT DATA 

IF ( INDEX -GT. INDMAX 1 GO TO ilO 
IF { INDPLT .EQ- 0 ) GO TO 130 
DO loa K=lff«CDDES 
CAuL VAROUT C IVRCODt KJ ,SSAVt( K) J 
100 CONTMUE 

WRITE I2i>) SSAVE 
GO TO 130 
110 CONTINUE 

WRITE t6,120) 

120 FORMAT C///1H tiOClH«) ,7HWARNING, 10 (1H=4=) , 66H THE KIJHBER OF DATA P 
+01NTS EXCEEDS AVAILABLE STORAGE FOR ONE RUN. ,20[m^i// 

+28XtA0H the DATA TO THIS POINT WILL BE PLOTTED.///} 

GO TO 2783 
130 CDWTINUE 

IF ( INDEX -LT. I POINT) GO TO 2706 


c, ==r=^====. restore ss parameter to original value 

2783 CALL VARMDD [ IND,PARSAV ) 

C =i==“==== RESTORE OPERATING POINT TO ORIGINAL VALUE 
CALL XFRtXICSAV»XICrNSlM) 


WRITEl 6,28711 
WRITE PLOT DATA. 

IFlIND-LT-0«0R-INDPLT.EQ.0)G0 TO 200 
C ==-— TRANSFER PLOT DATA TO PLOT TAPE — TAPE30 
lOPTlll - 5 
IDPTtSJ = NDiSP 
DO ISO l=l,NOiSP 
IDPT(5+I1 - NPLTStI) 

150 CONTINUE 

IDpTdZl = INDEX 
I0PTU31 = NCQDES 
IDPTIX4) = IPGPTC3) 

DO 155 K=1,NDISP 
DO 153 1^1,5 

NVRDHYtijljK) = NVARU,1,KJ 
153 CONTINUE 

DO 155 1=1,5 
NVRDMYCI,2,K1 = IJIDEP 
155 CONTINUE 

WRITE C30) I0PT,PL0TID,PTITLE 
WRITE (30) SCALE, NVRDHYjiVAR 
REWIND 25 
DO 180 1=1, INDEX 
READ C25) SSAVE 
WRITE 1301 SSAVE 
180 CONTINUE 
REWIND 25 
INDWR = i 
200 CONTIKUE 

IFSISS-EO-GJRETURN R1 
C 

RETURN 

4000 IFIIPRINT.EQ.SICALL LPRIMT { 2,TIME} 

CALL LPRINT(IPRINT,TIHt) 

C ========== SET XIC = STEADY STATE OPERATING POINT 



CALL XFR{XyXIC,J«SI«) 

C ===== 5 :==== GENERATE LINEAR STABILITY MATRIX 

CALL STA BMX I MSI M » XDOTO » I COUNT, RA TI □ , A , NL IINi, 0 1 
C ==;==^:^=== CALCULATE EIGENVALUES 

2862 CALL EGVL3I A5RATI0,£VR,EVI,IA,IB,IC,I0,DHDRK, 1.E-14,NLIN,NLIN) 

CALL NATFftQCEVR,EVI,WN,DAHPR9«UN,NPOLES) 

C ======-= print EIGENVALUES 

WRITE(6,2a6»7I NLINI 

2867 FORMAT I ////45H SYSTEM EIGENVALUES AT THIS OPERATING POINT 

I /// 28X, 1 3, 2X, =»=OGENVALU£S4=/l 3X,^R£AL*, 9X ,^IMAGX NARY=i^ 

i, 6X,*NATURAL FREQ-* tSX, ^S'DAMPING RATIO*) 

DO 2S6S I=l,^SPOLES 
a=ISLNK 

IF(EVIf D-GT-O.) J=IPOM 

2868 HRIT£l6,2869)l9EVRlI),JBEVIU),WNtI),DAMf>Rm 

286 9 FORMAT ( 3X » 1 5 , 3X ,GiZ- 6 , 2X , A2, G1 2. 6,4X 9 2G16- 6 ) 

WRITE1692671J 

2871 FORMAT!///// ) 

GO TO 2783 

C ======= ADVANCE PLOT INDEX AND SS PARAMETER 

2706 INDEX=INDEX+L 

PARAM=PARAM+DELTA 
£□ TO 3000 

4100 WRITE!6»4i01J INDEP 

4101 FORMAT !//I0X,3lH*** WARNING *** CAN*T IDENTIFY, iX,AB, IX » 

1 33HAS A VALID STEADY STATE PARAMETER//) 

WRIT Ei 6, 2871 j 
RETURN Ri 
END 
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CSTABMX 

SUBROUTINE STA3MXtNSlH»XD0TDffIC0UNTtRATl0»A»NLIW,ITEST) 

VERSION 3- REVISED 5 APRIL 30 1976 

PURPOSE CALCULATE STABILITY MATRIX 
CALL SEQUENCE 

ITEST = HDDE OF STABILITY MATRIX CALCULATION 

ITEST = 0 SKIP RATIO MATRIX CALCULATION 
ITEST = 1 CALCULATE RATIO MATRIX -J- STABILITY MATRIX 
ITEST = 2 CALCULATE STABILITY MATRIX * COMPARE WITH 
PREVIOUSLY CALCULATED A MATRIX 
ITEST = 5 CALCULATE ONLY THOSE ELEMENTS OF A MATRIX 
AS INDICATEO BY THE CODES STORED IN RATIO 
ITEST = -i SAME AS ITEST = 0. (THIS CONDITION OCCURS 

WHEN MORE THAN 400 /A/ ELEMENTS CHANGE DURING 
ITEST = 2») 


REAL XDOTO( iJjRATIOCI) ,AtiJ ,X{iJ fXDOTU) 

INTEGER INTCl) 

COMMON /CX/X/CXDOT/XDOT/CINI/INT/CXIC/XIC ( 1 J/ERMESS/IFATAL, lERR 
COMM DN/C N TR LS/AN T YPE , I PR IN T r MQ DE j. ER R OR (1 ) /C TI M E/ TI ME 
EQUIVALENCEERATflRATi 
INDEXFU1jI2»M11=I1+CI2-1J4M1 

= SET X = XIC (OPERATING POINT i 


DO 2S10 I=1,NSIM 
2610 X(Il=XIC(li 

rFlITEST.GE.2J GO TO 2S13 

“==—=== TURN ON ALL INTEGRATORS FDR INITIAL FUNCTION EVAL. 
DO 2812 I=I,NS1M 
IFIINTIIJ .EQ.O) l?4Tai=2 
2812 CONTINUE 

EVALUATE MODEL RATES 

XURN ON ERROR MESSAGES IN MODEL 

613 I£RR=1 

CALL EQM0{TIME,T1ME,1J 
yyj^ gpp ERROR MESSAGES IN MODEL 


IERR=0 

SAVE NOMINAL MODEL RATES 
DO 2615 I=i,NSIM 
2315 XOOTOilJ 

lFCITEST-2} 2816, 2818s 2900 
2816 NLlN=IiSIM 

=====x^== restore frozen states AFTER Iii«lTIAL FUNCTION EVAL- 
DETERMINE THE ORDER OF THE MODEL 
DO 2814 I^isNSIM 
IF(INT(I).NE.2J GO TO 2814 
INT(1}=0 
NLIN=NLIN“T 
2814 CONTINUE 
28 18 K1=0 


IC0UNT=0 

C ==========:==== SCAN COLUMNS OF STABILITY MATRIX ===:=“=:===^= 

DO 2845 J=1,NSIM 
C =:======:== SKIP FROZEN STATES 

IFdMTS JJ-NE.O) GO TO 2820 
K1=K1+1 


AND 


GO TO 2845 

C =====:== PERTURB THE JTH STATE 
2820 X( J) =XC JJ+ERRORtJJ 
C =======:= EVALUATE MODEL RATES 
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CALL EQMDiTIMErllMETiJ 
K2-0 

C ======= =====i=-= SCAN ROMS OF STABILITY MATRIX =========== 

DO 2630 I=l»NSm 
C ======== SKIP FROZEN STATES 

iFam‘(I).ME-0) GO TP 2621 

K2=K2-*-l 

GO TO ZB30 

2S21 J2=IKD£XFCI-K2sJ-KLsNLIN) 

IFtITEST-NE-25 GO TO 2625 
C ========== CALCULATE STABILITY MATRIX ELSMEfST 

XDUM = 4 X D GT C I ) -XD DT □(!))/ ERROR C J) 
t ====== COMPARE TO PREVIOUSLY CALCULATED VALUE 

IFtXDUM.EQ.At J2H GO TO 2630 

ICOUNT-ICQUNT+i 

IF SI COUNT -GT. 400) GO TO 2823 

C ====== GENERATE CODE IDENTIFYING THOSE ELEMENTS THAT CHANGE 

IRAT=1-M000*J-i- 1 0000004=32 
RATIO a COUN T J =RAT 
AtJ2)-XDUM 


GO TO 2830 
2823 lTEST^-1 

C ======== CALCULATE STABILITY MATRIX ELEMENT 

2825 A C J2 1 = { XDGT 1 1 i-XDOlO 4 1 ) ) /ERROR S J J 
2630 CONTINUE 

IFlITEST-NE.ii GO TO 2646 

C ========= linearity EVALUATION USING 1/2 SIZE PERTURBATION 

X( Ji=XlClJ)<-.5*ERR0R{Ji 


CALL EQHD [TIME, TIME, 1) 

K2==0 

DO 26^4 I=1,MSIH 
IFUNrSD-NE-O) GO TO 2835 
K2=K2H 
GO TO 2844 

2835 XDUM=CXDDTS1)“XDOTO«I) ) /ERRORS J) *2. 
J2=INDEXF(I-K2,3-Kl5NLIN) 

IF(A(42l)2a37, 2840, 2837 
2837 RATIOt JZ)-XDUH/AS J2) 

IFSABSSRATIOS J2)-i-) -GT- .1) ICOUNT^ICOUNT-i-1 
GO TO 2B44 
2840 RATlO{a2)=l^ 

2844 CONTINUE 
2846 CONTINUE 

XUl=XICi3i 


2845 CONTINUE 
RETURN 

C ======= CALCULATE ONLY THOSE ELEMEJOS OF STABILITY MATRIX THAT 

C ARE CHANGING. 

2900 K1=I COUNT 
K2=0 

2910 IFSKl-LE.Ol RETURN 

C ======== DETERMINE ELEMENTS OF STABILITY MATRIX TL BE EVALUATED 

C FROM CODES STORED IN RATIO. 

RAT=RATIDIKI ) 

J2-I RAT/1000000 
J=IR AT/ 1000-J 2^(^1000 
I=IRAT-J 24=100000 0”J*IO 00 
K1=K1-1 
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IF(J-EQ.K2) GO TO 2920 
K2=J 

Xf JJ=Xt Jl+ERRORCJ) 

CALL £QfiO£TIM£,TIM£»iJ 
X{ J1 =XIC£J) 

CALCULATE STABILITY MATRIX ELEMBSfeT 
2920 Ai J2 J = £ XOOTC D-XDQTO S IJ) /ERRCRC J ) 

GO TQ 2910 
END 
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CSTEPl 

SUBROUTINE STEPl aiHE,TIJ^Cl 
VERSION 4. REV IS EDS SEPT 17 1976 

PURPOSE: CALL INTEGRATION SCHEME SELECTED BY HDDE VARIABLE 

CALL SEQUENCES TIME - CURRENT TIME 

TING - TIME STEP TO BE TAKEN TO NEXT REPORT INTERVAL 
DESIGNED BY: J.D- BURROUGHS FES 1974 

COMMON/CORD ER/ NSIM 9 MOV , MOP/CX/X « 1 5 /CXDOT/XDOT { 1 J 
C DM MDN/CNTR LS/ I NSTR , I PRINT » MODE 9 ER R DR n ) 

COHMON/CWORK/A £ 1 } /CNORKN/NN » N1 , N Z>N3 s N4 , N5 ? N 6 , N7 
COMMON/ CTIHE/TIM/CSXHUL/PUM £7 i ,9 TM AX/CNAMEX/NAMEXC 1 J 
CDHHON/CDIFS/JSTART jKINITt TP 

SET NEXT PRINT TIME 

IP^TIME-MINC 

B GO TQISOOjlOOfBOOJ^MDDE 

====-==:=.==========—-== nRKVS integrator ======;"“=^=^===^= 

100 call DVERLAYIBHNRKVS,4,1,6HRECALU 
IFniME,GT-TMAX) WRITEC 69 101J C ItNAMEXC I) pAfftST-M-l) ,I=i 9 ^^SIM » 

101 FORMAT t//47X,^^lNTEGRA TOR STEP SIZE LIMITING COUNTS^/ 

1 5{I4j1X9AS*2H= tGII.SM 

KIN1T= 1 

IFtM0DE.EQ.l*AND.TIME«LT.TP-.000011G0 TO 5Q5 
RETURN 

— START GEAR INTEGRATION WITH INITIAL CALL TO NRKVS 
500 iFtKINIT*£Q.O» GO TO 100 

===^ss=;===========rr=^^= gear integrator =====“===========“=:= 

05 CALL OVERLAVCSHNONSIMjAjZjSHRECALL) 

IFCKINIT-NE-OJ RETURN 
GO TG iOO 

c ============== fixed step integrator =================== 

600 DT2=TlNC^-5 

CALL EQHO£TIME,TINC,OJ 
00 601 I=ljNSIH 
A 6 iJ-XtI)+pT 2 =«^XDDl{I) 

601 X£I)=X{ I)+TINC*XDOT{rj 
TIME=TIMfc-frTINC 

CALL EQMOdlMEjTlNCjO) 

DD 602 I=ifNSIH 

602 X£I)=A(IHDT2*X0QT(I) 

RETUiRN 

END 
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SUBROUT IN£ T ABIPi C Tii^a , TABNAH ,HAXD IM ?LOCTAa ,NOTAB I 
C VERSION 2-1 REVISED^ JAM 7 1976 

C PURPOSE: PROVIDE FREE FIELD READ OF TABULAR DATA FOR EITHER 

C SIM&LE OR DOUBLE TABLE LOOKUPS 

C CALL SEQUENCE: TAB - ARRAY INTO WHICH DATA WILL BE LOADED 
C. TABNAH ARRAY OF ALLOWABLE TABLE NAMES 

C HAXDIM - ARRAY OF MAX. DIMENSIONS FOR TABLES 

C LOCTAB - ARRAY OF TABLE LDCATIGMS I2« ARRAY TAB 

^ NOTAB «- NO- OF TABLES IM MODEL 

C METHOtiS "TABLE‘'DESCR‘jtPTlON IS IN THE FOLLOWING FORMAT 
C CARD i TABLE TABLE NAME NX N2 

C CARD 2* SECONDARY INDEPENDENT VARIABLE TABLE 

C CARD 3* PRIMARY INDEPENDENT VARIABLE TABLE 

C CARD 4=«= DEPENDENT VARIABLE TABLE 

C *US£ AS MANY CARDS AS DESIRED- MUST START TABLE WITH 

C A NEW CARD. MUST GIVE NZtNX, AMD NX=i^JiaZ POINTS RESPECTIVELY 

C IN EACH TABLE, 

C NX - NO- OF POINTS IN PRIMARY IND- VAR. TABLE 

C MZ - MO. OF POINTS IN SECONDARY IND- VAR. TABLE 

C DATA ITEMS ARE FREE FIELD- ITEMS MUST B£ SEPERATED BY EITHER 

C 2 OR MORE BLANKS? COMM A, EQUALS? OR LEFT OR RIGHT PARENTHESIS 

COMMON/CiO/IREAD?IWRITE,IDIAG 

DIMENSION CARO( 6 J , TAB £ 1) ?TABNAMC 1) jMAXOIMS 1 } ? LOCTAB £ i ) 

10 NX=G 
(iZ=0 
M0DE=0 

WRlT£aWRIT£?20l 
20 FORHAT£////J 

C - — > READ DATA CARD 

100 READ£IREAO,101)CARO 
id FORMAT? 8AI0) 

lFtEOF{ iREAO) -i^E«OjGO TO 6320 

C SET CHARACTER INDEX 

lNDEX=i 

C “> LOCATE NEXT PHRASE 

120 CALL NXTPH £CARD, INDEX, PHRS) 

C — > test for blank phrase 

IFCPHRS-EQ-lOH IGO TO 100 

C > TEST OPERATING MODE 

IFiMDDE.NE«0)G0 TO 130 

C ===^======:===== = ==;==:==:== M0D£=0 == CHECK FOR TABLE 

CALL W(UH£RCtPHRSJ,RETURMS{122i 
GO TO 100 

122 1FCPHRS-NE.5HTABLEJG0 TO 6500 
MODE^i 
GO TO 120 

130 IF£HODE-GT-i)GO TD 140 

c ====:=====;z=: = ^====i=======r= MQDE=1 == STORE TABLE NAME 

CALL NU«ERC£PHRS)»RETURfgSfii60J 

C NUMERIC PHRS 

GO TO 6300 

C > CONVERT BCD TO REAL 

c hODE -GT. 1 

140 CALL NUM£RC( PHRS Js RET URNS £6200 J 
CALL bCDREL £ PHRS j PHRS) 

C BRANCH TO TASK INDICATED BY MODE 

160 GO TO£1000s2000?3000?40QOs5000p6000)9MQDE 
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G ======== p^ODE=I == STORE TABLE NAME 

IDLO CALL LCHPHlPHRSjTABNAHsjHOTABflsS^TAB) 
iF(NTAB<.LL.O)GO TO 1100 
C — -> STARTING LOCATION FOR TABLE DATA 

L0C=LDCTASC?4TAB) 

C — -•> LAST WORD ADDRESS FOR TABLE DATA 

MAX=MAXD1MCNTA&)+LDC-I 
TABtLOO^PHRS 
MQDE=2 
GO TO 120 

1100 WRITElIWRITEsllODPHRS 

1101 FDRMATtlTH WARNING sAiO^ 

1*XS WOT A VALID TABLE NAME FOR THIS MODEL* DATA WILL BE IGNORED*) 
GO TO 10 

C ==================== M0DE=2 — STORE NO. POINTS IN PRI. IND» TABL 

2000 TAB(LDC-*-l>-PHRS 
NXMA>t=:PHRS 
M0DE=3 

CALL J6XTPHtCARD,lND£X,PHRS5 
GO TO 140 

C ======================= MGD£=3 == STORE NO. POINTS IN SEC. IJSD- TABLE 

3000 L0C=LDC‘t-2 

TAB< LDCJ=PHRS 
NZMAX=PHRS 

C > TEST IF THERE IS A SECOaDAY INDEPENDENT VAR- TABLE 

IF(NIMAX.LE.l) GO TO 3020 
MDDE-4 
GO TO 3040 
3020 MODELS 
NZMAX=0 

5040 ITA3-L0C 

IFtLOC'i-NXMAX-t'NZMAX-5-WXHAX^MAAOC IrNZMAX) .LH*HAX)GO TO iOO 
LXM^MAXQIMiNTABj-3 
WRITE i I WRITE* 3041 1 NXH AX * NZHAX* LI H 
3041 FORMAT! 17H *** WARNING *** *14** PRIMARY AND **I4* 

I* SECONDARY INDEPENDENT VARIABLE POINTS EXCEEDS THE 
214* * WORD STORAGE LIMIT FOR THE*/21X, 

3*F0LL0W1NG TABLE. SOME DATA WILL BE LOST-*/) 

GO TO iOO 

C ================ M0DE=4 == STORE SECONDARY IND- VAR. TABLE 

4000 NZ=NZ+1 

IF1N2-GT-N2MAX)G0 TO 4040 
4020 ITAB=ITA&^1 

C > LIMIT DATA TO TAB ARRAY MAX. 

IF i I TAB . LE . M AX) TAB t IT AS ) =PHRS 
GO TO 120 
4040 HDDE=5 

C =================== models == STORE PRi- IND. VAR- TABLE 

5000 NX=MX+i 

IFlNX.LE-esXMAXSGO TO 4020 

HDDE^=6 

NX=0 

NZ=0 

C =================^==== M0D£=6 “ STORE DEPENDENT VAR- TABLE 

6000 ITAS=ITAB-i-l 

IF a TAB « LE« MAX) TAB tlTAB I =PHRS 
NX=NX-i-l 

IF(NX-LT«?4XKAX)G0 TO 120 
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MK-0 

MZ=NIZ+I 

IFtNZ«LT.NZHAX)GO ID 120 
C -> TABLt READ IN COMPLETE - PRINT 

6020 «RITElIWRITEy6021)lABlL0C-21 

6021 F0RHATt20Xj*TABL£ =«^,A7/) 

C > TEST IF THERE ARE 2 INDEPENDENT VAR» 

i; (NZMAX-LE-OiGO TO 6100 
WRITEaWRITE?6031i 

6031 FORMATti-OXT^SECCNDARY INDEPENDENT VARIABLE TABLE’S:/) 

ITAB^LOG 

WRiT£(IMRiTE,60A-l) (TABtlTAB+I) sl=X,NZMAX) 

60A-1 FORHATC1013X,G10,A) S 

6100 WRIT£(IWRITE»6101) 

6101 FORMATC/lOXs^PRIMARY INDEPENDENT VARIABLE TABLE’S^/) 

1TAB=L0C+NZHAX 

WRITEtIWRITE*604U CTASUTAB+1 J ,I=lsf^XHAX) 

IT AB =LDC +NXHA X+NZM AX 
NZ=0 

WRlT£tIMRITEf6i2l) 

6121 FORHATl/iOXsj’i'DEPEaMDENT VARIABLE TABLE’S:/) 

6140 WRITE (IWRIIE, 6041) (TAB CITAB+I) ,I=ln^XMAXJ 
NZ=^NZ+1 

IFCNZ-GE-NZMAX) GO TO 6400 

ITAB-ITAB+NXMAX 

GO TO 5140 

6200 BACKSPACE IREAD 

WRIT£(IWRI7E,6201)CARD 

5201 F0RHAT{50H WARNING ’*=’5=* NON-NUMERIC DATA ON THIS CARO— >t8A10 

1/17)%^HILL READ NEXT TABLE’S:/) 

GO TO 6020 

6300 WRIT LUWRiTEjBSOl) CARD 

6301 F0RMATt46H WARNING NON-ALPHA NAME ON THIS CARD— >? 

18A10/17X,*WILL IGNORE THIS CARD’S:/) 

GO TO 100 

6A0O WRITEtlWRITEjZO) 

GO TO 10 

6500 BACKSPACE IREAD 

C > CHECK THAT ALL TABLES HAVE BEEN INPUT 

6520 DO 6540 I-=l9N0TAii 
LOC=LOCTABlI) 

IF£K0MSTR(TAB?«AM(I),1»7,TAB{L0CJ ,1)«EQ«0)G0 TO 6540 
WRIT E£ i W RIT E , 6531 ) TABNAK 1 I ) 

5 531 FORMAT C//35H WARNING DATA FOR TABLE ,A?b 

HAS MOT BEEN INPUT’S:/) 

6540 CONTINUE 
RETURN 
END 
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SUBROUTINE TFEVALtOMEGAyPOLESfPQLEjNtRjLFLAGTlQUADT PHASE i 
VERSION 2. REVISEDs DEC 23 1975 

PURPOSE: EVALUATE TRANSFER FUNCTION COMPLEX VALUE AT SPECIFIED 

FREQUEfcSCY. 

CALL SEQUENCES OMEGA - SPECIFIED FREQUEauCV, R-H.S. (COMPLEX) 

POLES - SYSTEM EIGENVALUES WITH SH PARAMETER = 0 
POLE - SYSTEM EIGENVALUES WITH f^DMINAL SH PARAMETER 
N - SYSTEM ORDER 

R - OPEN LOOP TRANSFER FUNCTION (COMPLEX) 

LFLAG - ZERO PHASE FLAG, LFLAG =0 — PHASE>TOL, 

LFLAG = I — PHASE<TOL- 
IQUAO -- TRANSFER FUNCTION QUADRANT 
PHASE - APPROXIMATE PHASE ANGLE, RADIANS, 

DESIGNED by: J,D, BURROUGHS FEB 1969 

COMPLEX POLES IN ), POL£( M 1 ,OM£GA,R 
DOUBLE PRECISION RR,Ri,faR»DR»DlTRRijRR2»RR39ai&I 
COMM ON /CWQRK/RR j R I jNRs DR* D1 * RRI * RR 2 * RR3 , Ml 
RR=1-D0 
RI=0-D0 

=:===:==== CALC, ONE MINUS THE COMPLEX PRODUCT OF CFREQ-CLDSED LOOP 
POLES) / (FREQ-OPEN LOOP POLES) 

DO ICO l=l,*i« 
fa=DBLE(-REAL(POL£(l)) ) 

N1=DqLE ( AlMAGCOHESAl-AlMAGlPOLEt I ) )•) 

DR=DBLEC,~REAL(POLESU ) )) 

OI-DbL£(AiMAGtOHE&A)-AlMAG(PDL£S(I) ) ) 

RRi“DABS(DR) 

RR2=DABS(DI) 

1F(RR1.EQ,0,D0-AND-RR2,EQ,0-D0)G0 TO 100 
IF(RRi*,LT,RR2)G0 TO 50 
25 RRi=l,DO-HOI/OR)*=i^2 

RR2=(NR/DR+NI*0I/DR**2)/RR1 
RR3= (-NR*DI/DR**2+NI/DR)/RR1 
RR 1==RR*RR2-R 1 =«=RR 3 
Rl=RR=i=RR3+Ri^RR2 
RR=RR1 
GO TO 100 
50 RRX=NR 

NR=:N1 ! 

NI=“RR1 ! 

RiU=DR ! 

DR=D1 ! 

DI=-RR1 i 

GO TO 25 ^ 

iOO CONTINUE i 

R=(i,*0, >-CHPLX(SNGL(RR) sSNGU RU) 

PHASE=1« 570796 
C i===^=:=== CALCULATE APPROXIMATE PHASE ANGLE 
IF(REAL (R) ,NE,0, 1 PHASE =AIH AG (R )/REAL£R) 

LFLAG=0 

c s::===^== test for zero PHASE- TOLERANCE = ,00001 RADIANS 
IFtABSlPHAS£l-LT, ,00001 ) LFLAG^i 

C ===-===. DETERMi?4E QUADRANT OF TRANSFER FUNCTION 
iFtREALJR) ,LT, O.J GO TO 200 
IF(AIHA&(R),LT, 0,1 GO TO 300 
IQUAD=1 
RETURN 
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200 IF(AIMA&CR).LT. 0.} GD TO 250 
IQUA0^2 
RETURM 
250 IQUAD=3 
Ri£TUR}^ 

300 IQUA0=4 
RETURi^ 

END 


172 


BCS 40262-2 


o o 


CTFBTCH 

OVER LAY (TFSTCH, ? 5O J 
PROGRAM TFBTCK 

C VERSIOM 3,1 REVISEDs OCT 7 19T6 

C PURPOSE: CONTROL TtiH CALCULATION OF TRANSFER FUNCTIONS- 

C DESIGNED BY: J»D» BURROUGHS FEB 1974 

COMM DN/CORDtR/NSiH sNOVsNOP 
L0HMGN/CPR0N/DUHU4) yNINPUl yNOUT »0UM2f 2 ) 

C0MMtjN/CPR0V/DUM3£ 11 ) , FMAJC^FHINff OUH4m 
COMMON /CXiC/XiCii I /CINT/INT I i) 

COMMON /CNTRLS/ANTYPE, IPRINT,MDDEp ERROR { 1 ) 

COMMON /CWDRK/GA1NCB0)»PHASEC30J 9FREQ(50lffITIILEt9l fXMINJZi? 

1 XMAXiaJ ,YHIN£2),VMAXt2i 
COHMOM/CNAMfcX/NAMEXti J 
COMMON /LVI0RKN/NN,Nigi«2i,N35«l4»W59^6,N7 

COMMON /CPLQIS/ 1NDPLT,INDWR*IDPT130 * ^PLOTIOC SJsPTlTLEt 8), 

•i- iPOPTtiO) 

REAL XOPTJl) 

EQUIVALENCE tXOPTSDsiOPTfil J ) 

EQUI VALENCE ( A ,GA IN } 

REAL NAMEXpNiNPUTfNDUT 
DIMENSION JTYPE£2) ,AilJ 
DATA JTYPE/i»3/ 

DATA IBLWK /4H / 

NPTS = 50 

GENERATE lOENTXFXCAlI CW COOES FOR TF INPUT AND 
TF OUTPUT PARAMETERS 
CALL CODGENCNlNPUTs0»XNPUT),RETURNS£4000i 
CALL CODGENCNOUTjOsIOUT) tRETURNS £4020} 

I0PT£3> - IBLNK. 

I0PTC4) = liiLNK 
CALL QTTIH U0PTJ3}) 

WRITE{6,3020)NlNPUT,NaUT,PTITL£9 I0PTC3} ,X0PT£4} 

3020 FORMAT £40Xs4aH/=S=/*/=t:/ TRANSF ER FUNCTION ANALYSIS 

1 //51X,5HFR0M jAa,4H TO ,A8//26X paA10//54X » 2A12} 

C =s:======== PRINT OPERATING POINT AND PERTURBATION SIZE 

WRIT £16,2809) EI,NAHEX£II »XIC £ I J , ERRORS I ) ,INT { I J ,I=ItNSlH} 

2809 FORMAT £// 

i7Xf5HSTATE,6X»*0PERATING PERTURBATION INTEGRATORS^/ 
2SX,*NAMt*,6X®#pOINTsfts,9X,=«*SIZ£=f:,8X,:*sCONTRQL*/ 

2 C15,lX»A10sG14.5sG12»3,I9)) 

C ======== CALCULATE TRANSFER FUNCTION GAIN AND PHASE 

CALL TRNFCM£ INPUT, IDUT,NS1M,NLIN, GAIN, PHASE, FREQ, A, A £NN) ,A£N1), 
I A£N2),A£N31,A{N41,A£N51,A(N6I ,A(N3),A(N4) ,A£N6) ,AlNin, 

I RETURNS 1 3390} 

JPLOT^l 

C ======== PRINT RESULTS IF MANUAL SCALES HERE NOT SPECIFIED- 

IF £ FMIN- GE-FH AX }WRITE 16,3320 } t £ FREQ£ 1 + 1 K-1 ) ^IQ) ,I =i, 10 ) , 

1 £GATN£I-i“li<-ll=1^10} ,1-1,10), £PHASE{I+£X-i)=S:lO} ,1 = 1, 10 ) ,K=i,5 } 
3320 FORMAT £/ ('to FREQ-,RPS:^,i□GI2-5/7X,#&AINs4:,I0GI2•5/6X,=^<PHASE^’t, 
I 1QG12-5)) 

IF £ FMIN »GE» FHAX ) GO TO 400 
FREQUI = FMIN 
FREQ (NPTS) = FMAX 

C ========== CALCULATE RESPONSE OVER SPECIFIED RANGE 

CALL RESPONt INPUT, IDUT,NSIM,NLIN,GAINsPHASE, FREQ, A, A£NN),A£N1), 
1 A£N2),A£N3),A£W4J,A(N5},A£N6l,A(N3},A£N4) ,A£N6 ) ,A£NI} }, 

1 RETURNS £33901 
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WRiTEt 6 ,3320 ) ( { FREQ ( 1+ [ K-1 J *101 , 1 =^1, 10 } , 

1 {&AI?^U-f-{K-l)*i0),I“i,10),CPHASEa+(K”lJ^I0)rI=i»10J,K-Xy5J 
400 CONTINUE 

WRITE(6,3321) 

3321 FORMAT (/////) 

SET PLOT PARAMETERS. 

TF i INDPLT -EQ. 0 ) GO TO 6000 
lOPTU) = 4 
I0PT(2J - I0PT(2) +1 
IDPT{3) = IP0PTC5J 
iQPT£ 6) - IPDPTC6) 
lOPTt 7i ~ IPQPT{7) 

IDPT( S> = NPTS 
XQPTC9) = NINPUT 
XOPT £10) = NQUT 
DO 300 1=11,19 
300 lOPTCn = 0 
C ======:^=== WRITE PLOT DATA ONTO TAPE30 

WRITE £30) lOPT,PLQTID,PTITLb 

WRITE £30) £FftEtim,I=l,NPTSi,CGAIN£I),I=i,NPTSJ , 

+ JPHASEtl) ,I=1,.NIPTS) 

INDWR = 1 
GO TO 6000 
3390 CONTINUE 

WR1T££6,3321J 
GO TO 6000 

4000 WRITE £6,4001) NINPUT 

4^01 FDRMAT£//10X,31H*** WARNING *** CAN*! IDENTIFY, IX, AS, IX, 

1 44HAS A VALID TRANSFER FUNCTION INPUT PARAMETER//) 

CALL C00GEN£NljUT,0 5 LOUT), RETURNS £40 20) 

WRITE£6,332i) 

GO TO 6000 

4020 WRITE£6,402i J NDUT 

44i21 FORMAT £//10X,31H*** WARNING *** CAN*T IDENTIFY, IX, AS, IX , 

1 45HAS A VALID TRAMSFf" FUNCTION OUTPUT PARAMETER//) 
WRITE£6,332i) 

6000 CONTINUE 
END 
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suaRouiiNe: ihsszcajICjIAtNjMJ 

C SUBROUTINE TO TRANSFORM UPfER BLOCK TRIANGULAR MATRIX INTO 

C HESSENBURG FORM USING DIRECT REDUCTION WITH PIVOTINGo THE 

C MATRIX A IS REPLACED BY ITS UPPER HESSENBURG FORM AND THE 

C ITIANSFORMATIDN ELEMENTS ARE STORED IN A BELQ^ THE FIRST 

C SUBBIAGONAL. PIVOT INFORMAT I0?<3 IS STORED IN lA, 

C IC IS THE VECTOR PASSING THE BU3CKING INFORMATION FROM THE 
C PRECONDITIONING ROUTINE PREC2, 

C METHOD USED IS ONE USING ELEMENTARY LINEAR TRANSFORMATIONS. 

C 

C THIS PROGRAM WAS DESIGNED AND CODED BY A. FREDERICK PATH OF 

C BOEING COMPUTER SERVICES, SEATTLE, WASHI^SGTON. THIS VERSION 

C WAS COMPLETED DURING APRIL 1975. 

C 

DIMENSION AtM,l>,IAll),lCil) 

DOUBLE PRECISION SUM 
DO 10 I=i,N 
XA(I}=I 
10 CONTINUE 

IF(N.LE.E) RcTURN 

NA=XCIU 

IB=1 

K=2 

C DETERMINE MAXIMUM SIGMA 

15 VH=0, 

ii=K 

IFCNA.lT.K-4-1 J GO TO 52 
DO 17 I-K„NA 

lF(AbSIAiI,K-l) ).LE.VM) GO TO 17 
VM=A&S(AUtK-|.S ) 

IT=I 

1? CONTINUE 

C INTERCHANGE ROWS AND COLUMNS 

J=-1AIKJ 
IA{K)=IACIT) 

IAiITJ=U 

IFCK.EQ.IT) GO TO 22 
DO 20 J=1,M 
VM=AIK,J1 
AIK, JJ=AtIT, JJ 

20 A(IT,Ji=VM 
DO 21 I=i,NA 
VM==AU,Ki 
A(I,K>=AtI,iT> 

21 ACI?IT)=VM 

C COMPUTE TRA^gSFORMATION VARIABLES 

22 IFtA{K,K-D) 30932,30 

30 KK=K-i-l 
VM=1,/A(K,K-1J 
DO 31 J=KK,NA 

31 A{ J,K-l)=At J,K-U*VM 

C COMPUTE NEW H AND SIGMAS 

32 K^K+1 
KBC=K-1 
IK=1 
11=2 

IFtKK.LE.NAj GD TO 321 
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ia=i a+x 

NA=ICtiSJ 

3EX 00 36 1=1, NA 

IFtl.LE.ICdKJI GC TO 322 

I1=IC{IK^^2 

IK=1K+1 

322 IF(K«GT.NA) GO fC 34 
SUH=ACIrKK} 

DO 33 J=K,NA 

33 SUM=SUK+ACI,rJi^ACJ,Kl^~l) 
AtI,KK.J=SUM 

34 IFCX«LT»3J GO TO 36 
L=I-l 

1F{L-GT«KK1 L=KK 
IF{II«GT«L) GO TO 36 
SOH=AaTKKy 
DO 36 J=il,L 

33 SUM=SUH-AtI,J-lJ4^A(J,KK.i 
A{I,KK)=6UH 

36 CONTINUE 

IF{K-N) 13,32,30 

30 RETURN 
END 
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CTITLE 

SUBROUTiriE TITLE {CARD,iM,TITL,NT) 

V'ERSIOK 1. revised: MAY 15 1975 

PURPOSE - TO LOCATE AND CENTER A TEXTUAL TITLE. 

CARD - INPUT CARD IMACrE 

IN “ CHARACTER AT WHICH TO START SEARCH 
TiTL - RESULTING TITLE 

NT - NUMBER OF CHARACTERS IN TITLE FIELD 

DIMENSION CARO m, TITL tlJ 
DATA BLNK /lOH / 

DATA COMMA /I OH, / , EQUAL /IOH= / 

FIND FIRST NON-BLANK CHARACTER- 

DQ 10 I=IN,SO 

11 = I 

call GETTtCARDrI,CHAR) 

IF { CHAR «£Q. COMMA ) GO TO 10 
IF fi CHAR .EQ. EQUAL > GO TO 10 
IF ( CHAR -NE- 5LNK ) GO TO 20 
10 CONTmUc 
RETURN 
20 CONTINUE 

FI?SD LAST CHARCTER. 

12 = 81 
DO 30 I=IN,80 
12 = 12 - 1 

CALL GETTtCARD,I2sCHAR} 

IF i char «fSE. BLNK i GO TO 40 
30 COMTBaUE 
40 CONTINUE 

mVE TITLE INTO TJ.TL ARRAY. 

NW = {NT-iJ / 10 + X 
DO 50 

TITL a J = BLNK 
50 CONTINUE 

NC = 12 - li 1 
J1 = {!Sf¥-NCi / 2 -fr 1 
J2 = J1 + NC - 1 
K, = 11 

DO 60 I=JX,J2 
CALL GETT(CARD^K.,CHAR3 
CALL PUTTIUTLsI.CHAR) 

K = K •t' i 
60 COMT ISSUE 
RETURN 
END 
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CTRNFCfJ 

SUBROUTINE TRNFCN(INPUTfIOUT,NSIH,NLIN,GAlNTPHAS£,FRtQT 
i AwRATia,XDOfO,UWORK,IA,IBpIC,ID,EVR,£VI,POLESi,PQLESl) ,RETURNS{RU 
VERSION 3.1 REVISEDs OCT 5 1976 

— ~>PURPDSE: 

CALCULATE THE TRANSFER FUNCTiOM FROM SPECIFIED iS«PUT TO 
OUTPUT POINTS IN MODEL. 

CALL sequence: INPUT - TF INPUT IDENTIFICATION CODE 

IDUT - TF OUTPUT IDENTIFICATION CODE 

NSIM “ NONLINEAR SYSTEM ORDER 

NLIN - LINEAR MODEL ORDER (WITHOUT FROZEN STATES) 
CAIN - 50 X 1 CAIN ARRAY 

PHASE - 50 X 1 PHASE ANGLE ARRAY 

FREO “ 50 X 1 FREQUENCY ARRAY 

NAME DESCRIPTION LOCATION 

A - NLIN X MLIN WORiC SPACE /CWORK/ACl) 

RATIO ~ NLIN X NLIN WORK SPACE /CWORK/A(NN I 

XDDTO - NLIN X i WORK. SPACE /CWORK/ACNl) 

DWORK - NLIN X 1 WORK SPACE /CW0RK/A1N2) 

lA - NLIN X I WORK SPACE /CW0RK/ACN3) 

16 - NLIN X 1 WORK SPACE /CWDRK/ACN41 

IC - NLIN X 1 WORK SPACE /CM0RK/A(N5> 

ID •" NLIN X 1 WORK SPACE /CWDRK/A(N 6 J 

EVR - NLIN X 1 WORK SPACE /CWDRK/A(N3i 

£VI - NLIN X 1 WORK SPACE /CW0RK/A(N4) 

POLES - NLIN X i WORK SPACE /CW0RK/A(N6S 

POLES 1 - S^LIN X 1 WORK SPACE /CWORK/A(Ni) 

RETURN R1 — RETURN TAKEN WHEN ALGEBRAIC LOOP EXISTS 

BETWEEN TRANSFER FUNCTION INPUT AND OUTPUT. 
DESIGNED BY: J-0- BUR.ROUGHS FEB 1974 

COM M ON/CN TR LS /AN TYP E , I PR IN , I MO DE * ERROR ( 1 ) /C T I M £/ TI ME 
COMM ON / CK/X ( 11 /C XOOT/XD OT (1 ) /Cl NT/ INT U ) /C X IC/X lC{il/CP/P(i) 
DIMEJ^SiOii DWGRKC1)<?XA£1J ,iaCl),ICllJ ,IDU 1 
DIMENSION POLESdJgpQLESlUltAUJ.RATIOd) 

REAL GAINU 1 , PHASE S 1 S , E VR( 1 1 ,£ VI 1 1 1 5 FREQ£ I ) » XDOIOI 1 1 
COMPLEX POLES, POLESltTRANS, OMEGA 
INDEXZt 
NPTS=50 

c- X:ALCULATE stability matrix at op. PQI84T 

CALL STABMX ( NSIM , XDOTD , 1 COUNT, RATIO, A,NLIN ,0 ) 

C- >CACLULATE EIGENVALUES AND LOAD INTO COMPLEX ARRAY 

CALL Et^VLS i. A , RA TIO , EVR* EVI ,IA,IB *IC, ID, DW ORK, 1 . E — 14, NL IN , NLIN 1 
DO 100 I=i,NLZN 

100 P0LESII1=CMPLX(EVR[I1 ,EVUI1) 

IAL=D 

C ^>UPDATE XDOT 

CALL EQMD(TIME,TIME,i) 

C >DETERHrN£ I-D VALUES AT OP. POINT 

CALL VARDUTC IOUT,aUTO} 

CALL VAROUT (INPUT, aINPUT) 

C >PERTUR& INPUT 

AIN=AINPUT-.l 

C >INPOT = PERTURBED VALUE (EVALUTE EFFECT ON MQOEL) 

CALL SETINdNPUT,AIN) 

CALL VARCUTdOUTjOUT) 

C >RE STORE INPUT TO AINPUT 

CALL VARMODi INPUT, AINPUT 1 
C ^>PRINT WARNING 
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IFCOUTD .EQ.DUT} GD TO 350 

ALGAIP«= tOUTO-QUT 

IAL=^1 

WRITE< 6,255} AL&AIM 

255 FORMAT C//10Xj46H WARNING ALGEBRAIC LOOP WITH GAIN DF , 

1 Gi2.6,« EXISTS BETWEEN INPUT AND UUTPUT=4=/ 

2 ^ THIS TRANSFER FUNCTION CAN NOT BE DETERMINED*) 

RETURN: RL 

C ^>INACTIVE STATE COUNTER 

350 K1=0 

C -“>CALCULA'f£ A WITH I/O LOOP QF -1 GAIN CLOSED 

DO ?00 J=l,NSIiM 
IFUNT(J).NE,0) GQ TO 450 
Kl=Ri.+l 

C' >SCASfe STATES 

GO TO 700 

C ^>PERTUR& STATE 

450 X{ J}=XIC{J)+£RROR{J) 

C >EVALUATE MODEL 

CALL EQH0CT1ME,T1ME,1) 

C >READOUT I/O 

CALL VAROUTIIQUT, OUTPUT) 

CALL VARCUK INPUT, AINPUT) 

AIN-AINPUT-OUTPUT+OUTO 

>HODIFY INPUT BY -S* ANY CHAN.’C THAT HAS BEEN OCCURRED IN OUTPUT? 

>AND EVALUATE MODEL 

CALL SETINdNPUTjAlNI 

“>INACTlVE STATE COUNTER 

K2=0 

>SCA^* RATES 

DO 600 I=1,NS1M 
IFCINTCD-NE.OJ GO TO 500 
K2=K.2+l 
GO TO 600 

>CALCULATt A ELEMENT 

500 Al 1NDEX2 1 1~K2 ? J-KI ,NL124 ) ) ={ XDCTt I ) -XDQTQi I ) )/ERRDR{ J ) 

600 CONI INUE 

>RESTORE INPUT TO AINPUT 

CALL VARMODt INPUT, AINPUT) 

>RE STORE STATE TO 0P„ POINT VALUE 

X(J)==XIC(J) 

700 CDNTIi!«U£ 

XiALCULATE EIGNEVALUES WITH -1 CLOSED AND LOAD INTO COMPLEX 

ARRAY POLES! 

CALL EGVL3C A,RAT10,EVR,£VI,IAvIB,ICbXDDTDtDWORK, i,E-14,NLIN?NLXN) 
DO 750 I=1?NLIN 

750 PQLESil I}=CMPLX{EVR( 1) ,EVI{I)I 
FREQ (50) =-l.£36 
FREQfl)=l-£36 

C DETERHIPSE FREQUENCY RANGE TO SCAN *** 

DO 800 I=l,NLIN 

IF(CABSSPOL£S(I) ) -LT-FREQ(l)) FREQ{ I)=CABS(POLES(I J ) 

IF ( CABS t POLES ( I ) ) • GT- FRE Q ( 5 0 ) ] FREQ 1 50 ) =CABS ( POLES (ID 
800 CONTINUE 

FREQ ( 50 ) =^10 -*FR£Q C 50 ) 

FREQ(i)=.I*FRtQa) 

C *** ENTRY POINT FOR MANUALLY SELECTED FREQ. RANGE *** 

ENTRY RESPON 
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IFCFREQSl).L£.-0-) FREQ(i) = -QI 

RAT-EXP £ ALQG i AaS I FREQ [ 50 ) /FREQ C i ) J )/£ MP TS-1 n 
OHEG A=CMPtX £ 0 « , FREQ £ 1 ) ) 

C CALC- FR£Q« RESPONSE FROM NOMINAL A5aD MODIFIED SYSTEM POLES 
DO 1000 I=1,NPTS 
TRA^4S=C 

FR£Qa)=AlMAG(DHEGA) 

DO 900 J-i,NLIN 

900 TRANS=CaHEGA-POLESit J1 )/(OME&A”POL£S( Jn^i^TRAWS 
TRAN S=TR ANS- £ 1 - , 0 « ) 

GA IN £ I) =CABS 4 TR ANS ) 

XFUEAL{TRAi«Si-£Q-0.-AMD.AIMAG£TRANS}»EQ-0-} GO TO 950 
PHAS££ IJ =57- 29578WAN2(AIMAG£ TRAMS) ,R£ALCTRAMS J ) 

GO TO 1000 
950 PHASEtI)=0- 
100 0 0M£GA=RAT4=DM£GA 
RETURN 
END 


180 


BCS 40262-2 



CVALUES 

JiUfiROUTiNE VALUESe IPHRSjNAMEtNOsVALUEtZTNOffMQDE) 

C PURPOSES LOADS i^UHcRIC VALUES OF QlUiAWTITIES IDEOTIFIED BY DEFINE 
C STATEMENTS- 

C CALL SEQUENCES IP HRS == ARRAY CONTAINI^SG NEXT PHRASE TO BE EXAMINED 
C NAME - ARRAY CONTAINING NAMES OF DEFINED QUANTITIES- 

C NO = NUMBER OF DEFINED QUANTITIES- 

C VALUE = ARRAY INTO WHICH NUMERIC VALUES ARE TO BE LQA 

C ITND = POSITION OF GlVtfi# QUANeTITY IN NAME ARRAY. 

C MODE = MODE OF OPERA? I 

C MODE =0 A NAME CAN^T BE IDENTIFIED. 

G MODE = 2 NAME HAS BEEN IDEMtlFIED- 

DIMENSIDN NAH£(NO) 5fVALUe<N0) 

REAL iPHRSjNAME 

C TEST FOR NUMERIC FIRST CHARACTER. 

CALL NUM£RC{IPriRS> ,RETURNSI50i) 

CD TO 200 

C SEARCH NAMELIST FOR NAME COKiTAINED IN IPHRS- 
50 CALL LCMPHC XPHRSfNAMErNOrlsITNDi 
IF{ITNO.LE-0) GO TO 100 
C NAME FOUND AT LOCATION ITNO- 
M0DE=2 
RETURN 

C NAME NOT FOUND - 
iOO WRiT£(6slOi) IPHRS 

LOi FORMATC 15Xj33H=S'=}«* WARNING CAN*T IDENTIFY ,A10r 

i 23H VALUE WILL BE IGNORED) 

M0DE--1 

RETURN 

C TEST MODE TO ASSURE THAT NAME HAS BEEN IDENTIFIED- 
200 IFiM00£-NE.2) GO TO 300 

C CONVERT NUMERIC VALUE CONTAINED IN IPHRS FROM A TO G FORMAT - 
CALL BCDREL(VALUE(IT^30),IPHRSJ 
MDOE^Ei 
RETURN 

300 WRIT£(6,30iUPHRS 

301 FORMAT {15X,7iH**^ WARNI?a& A VALID PARAMETER NAME MUST PRECEDE 

1 THE NUMERIC VALUES ,A10J 

RETURN 

END 
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CVARMDD 

SUBROUTINE VARHODCIyVAR) 

PUR rases TG MODIFY THE CURRENT VALUE OF A STATE? VARIABLE, 

PARAMETER, ETC» GIVESi THE IfcifTEGER IDENTIFICATION CODE 
FDR THE QUA NT I TY- 

CAU SEQUENCES I = lOEMTlFICATIQN CODE- 

VAR = NEW NUMERIC VALUE BEING INPUT- 
COMM ON /CX/X ( 1 ) /CXD OT/X DOT C 1 ) /C V/ V U ) /CP /P fiJ /C XI C/XI C C i ) 

COMM ON/C TIME /TIME 

C TEST FO.R PARAMETER CODE 

IF{I-L£®40O0000.OR.I-&t-B00000Ol GO TO 10 

PU-40D0000)=VAR 

RETURN 

C TEST FOR IC CODE 

10 IFtI .LE.2000000»OR»Ie.GT»3000000i GO TO 20 

XIC U-2000000 ) -VAR 
RETURN 

C TEST FOR VARIABLE CODE 

20 IFU«Lfc-3000000«OR*.X»GT-4000000J GO TO 30 

V(I-3000000J=VAR 
RETURS^ 

G TEST FOR STATE CODE 

30 IFU-LT,1.0R.I.GT-iOOOOOO} GO TO 40 

XiI)=VAR 
RETURN 

C TEST FOR RATE CODE 

40 IFEI-LE.1000000-OR-I-GT-2000000J GO TO *>0 

XDQTtl-lGuGOOO) =VAft 
RETURN 

C TEST FOR TIME CODE 

50 IFSI.EQ.O) TIME=VAR 
RETURN 
END 
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CVAROUT 

SUBRPUTINE VARQimisVAR) 

PURPOSE: TO RETRIEVE THE MUMERIC VALUES OF STATES, VARIABLES* 

PARAMETERS, ETC. GIVEN THE INTEGER IDENTIFICATION CODE 
FOR THE QUAi«TlTY DESIRED- 
CALL sequence: I = IDENTIFICATION COOE- 

VAR ^ NUMERIC VALUE RETURNED* 

CQHMDN/CX/X I i ) /CXDOT/XDOT i 1 ) /C V/ V ( 1 ) /CP/P 1 1 ) /CXIC/XIC { 1 ) 

COMM ON/CTIHE/TIME 

C TEST FOR TIME CODE 

IFtI-N£.43r) GO TO ID 
VAR=TIM£ 

RETURN 

C TEST FOR STATE CODE 

IQ IFd-LT.i-OR-I.&T. 1000000) GO TO 20 

VAR=X(I1 
RETUR34 

C TEST FOR VARIABLE CODE 

20 IF(I-L£-30aOOOO.OR-I-GT-4000000J GO TO 30 

VAR=VCI“30000QO) 

RETURN 

C TEST FOR RATE LODE 

30 IFII-LE-3L00000Q-DR-I.GT-20000001 GO TO 40 

VAR=XOGT ( I-iOOOOOOJ 
RETURN 

C TEST FOR PARAMETER CODE 

40 IFtI.L£»4000000-DR-I«&T-5000000) GO TO 50 

VAR=P( 1-4000000) 

RETURN 

C TEST FOR IC CODE 

50 IFli*LE,2000000-0R.I.GT-30000001 GO TO 60 

VAR- XI C 1 1-20 00000 ) 

RETURN 

C CODE NOT IDENTIFIED. SET VAR TO LARGE NUMBER- 

60 VAR=l-£36 

RETUiRH 
END 
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CXFR 

SUBROUTIME XFRtXfYjNI 
0I«E3«SI0m X{Mj,YCi«) 

DO 100 1^1 tH 
100 r{x>*==x£ii 
RETURM 
END 
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4.0 PERMANENT FILE MAINTENANCE PROGRAM DESCRIPTION 

4.1 INTRODUCTION 

The Permanent File Maintenance program (FILOAD) is used to load and modify 
standard component input-output descriptions which are kept on the permanent 
file, WMPF. This program is used only when it is necessary to modify the 
input, output, or table list of an existing standard component or when a new 
standard component is to be added to the system. 

4.2 PROGRAM STRUCTURE 

Figure 4.2-1 contains a macro flow diagram of the Permanent File Maintenance 
program. Statement numbers in the main (FILOAD) program are given for each of 
the program's five principle tasks. The sequence of performing these tasks 
depends on the program commands. As each command is read it is printed on the 
lineprinter to provide a record of progress through the set of coimiands. 

4.2.1 Command Interpretation 

The consnand interpretation process for the FILOAD program is shown on Figure 
4.2-2. Each phrase is tested against the five possible command phrases: LIST 
STANDARD COMPONENTS, PURGE, NEW FILE, DUMP FILE, and SYMBOL, If one of these 
phases is identified, branching occurs from statement 300 to a location that 
performs these tasks. 

The LIST STANDARD COMPONENTS command sets a flag, (LIST=1), which causes the 
input, output, and table lists of any new or modified components to be printed 
upon the completion of processing all input commands. The PURGE command causes 
the name of the purged component to be removed from the list of standard 
component names, CMPNTS. This results in the removal of all name lists associ- 
ated with that component from the WMPF file, when the degas process is per- 
formed at the end of the run. The SYMBOL command causes the symbol number 
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FIGURE 4.2-1 PERMANENT FILE MAINTENANCE PROGRAM - MACRO FLOW DIAGRAM 
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following a standard component name to be added to characters 9 and 10 of that 
name via the PUTCOD routine, 

4.2.2 Name List Loading 

If a phrase is not a command phrase, characters 3 through 6 are compared to the 
three acceptable input name list types: INPT, OUTP, and TABS. If one of these 
three types is not recognized, a warning message is printed and a flag (L0AD=0) 
is set to prevent data from being loaded onto the WMPF file. If a recognizable 
name list type occurs, the component name is obtained from characters 1 and 2 
of the phrase. This component name is compared to existing component names. 
If it is an existing component name, the specified name list for that component 
is modified. If the component name does not match an existing component name, 
the new component name is added to the list of library components and a notice 
is printed that a new component has been added. Default input, output, and 
table name lists of zero length are then added to the WMPF file to assure that 
all three lists exist for all components. This is necessary to prevent READMS 
errors in the Model Generation program for components that might otherwise not 
have table name lists. The name list contained in the input data is then read 
and loaded onto the WMPF file. 

The name list data is not in a free field format. The number of names must 
match that given in the phrase following the input list name, and the format of 
the name data must match that given in Section 7.0 of Volume I. Errors in 
formatting name list data can cause erroneous lists to be loaded. These will 
lead to errors in connections to the affected component. 

4.2.3 File Degas Procedure 

The WRITMS routine leaves previous versions of stored items on the permanent 
file as "dead space" whenever the new version is of a different length than the 
original. In order to remove this dead space, the FILOAD program creates a new 
copy of the WMPF file on local file TAPE79 upon the completion of each run. 
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TAPE79 is loaded by copying the Input, output, and table name list for each 
component listed in the list CMPNTS, from WMPF. During this copy, the name 
lists for any purged components are deleted. Upon successful completion of the 
run, TAPE79 is copied onto WMPF. 

4.2.4 Permanent Files 


The random access permanent file WMPF is referred to in the FILOAD program as 
TAPE78. This file contains an input, output, and table name list for each 
standard component and a list of all standard component names. 

4.2.5 Warning Messages 

Table 4.2-1 lists the three warning messages that can be generated by the 
FILOAD program. These messages are preceded oy; ***WARNING***. If either 
messages 1 or 2 are printed, the name list associated with these warnings will 
not be loaded. Other correct name lists for that or other components will be 
loaded. 

4.3 FILOAD PROGRAM SOURCE LISTINGS 

Compilation listings of the source code for the FILOAD program follows. Some 
of the subroutines are also used in the other programs. The names of the 
FILOAD routines, listed in alphabetical order, are: 


BCDREL 

KOMPAR 

COMDAT 

KOMSTR 

CSORT 

LCMPH 

DUMPPF 

NUMERC 

FILOAD 

NXTPH 

GETCOD 

PUTCOD 

GETT 

PUTT 

I SCAN 

STRMOV 
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TABLE 4.2-1 PERMANENT FILE MAINTENANCE PROGRAM 
WARNING MESSAGES 

1. CAN'T IDENTIFY xx AS A STANDARD COMPONENT 

The phase xx following the command PURGE or SYMBOL is not an existing 
standard component name. Check spelling of xx. 


2. IN xxxxxxxxxx zzzz ISN'T A RECOGNIZED NAME LIST TYPE. 

NAME LIST WILL NOT BE LOADED. 

Characters 3 through 6, zzzz, in the phrase xxxxxxxxxx should be one 
of the name list types: INPT, OUTP, or TABS. Check spelling of 

xxxxxxxxxx. 


3. xxxxxxxxxx ISN'T A VALID NUMBER OF NAMES FOR NAME LIST. 

NAME LIST WILL NOT BE LOADED. 

A numeric phrase giving the number of names in the following name 
list must follow the component name list type phrase. 
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CBCDREL 

SUBROUTINE BCDREL«VALUE*PHRS 1 
PURPOSE: CONVERT BCD NUMERIC INFORMATION INTO REAL FORMAT 
CALL SEQUENCE: VALUE - REAL NUMERIC VALUE ON RETURN 

PHRS - LEFT ADJUSTED BCD CHARACTERS ON INPUT, 

• > SCAN CHARACTERS RIGHT TO LEFT TO LOCATE FIRST NON-BLANK 

DO 100 1=1*10 
J=ll-I 

CALL GETTtPHRSt J»CHARJ 
IFCCHAR.NE.lOH } GO TO 120 

100 CONTINUE 

C > CALC. NO. OF BITS OF LEFT CIRCULAR SHIFT REQ D 

120 J=6^J 

VALUE=SHIFT£PHRS,J) 

C > CONVERT BCD -> REAL 

DECODEC 10, 101, VALUEJVALUE 

101 FORMATCGIO.O) 

RETURN 

END 
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CCQMDA7 

SUBROUTINE COMDAKCOHNAMtTYRE ,N,NAMES J 
purpose: obtain LISTS OF INPUTS, OUTPUTS, OR TABLES REQUIRED 

FDR A SPECIFIED STANDARD COMPONENT 
CALL sequence: COMNAM - STANDARD COMPONENT NAME 

TYPE - TYPE OF LIST REQUESTED E.6. INPT,OUTP,TABS 
N - NUMBER OF NAMES IN LIST 

NAMES - NAMES OF QUANTITIES 

METHOD: LISTS ARE STORED ON A RANDOM ACCESS PERMANENT FILE AND 

ACCESSED VIA THE MASS STORAGE I/O FEATURES OF FTN, 

FOR EACH STANDARD COMPONENT* 3 LISTS WILL BE CREATED 
WITH THE INDEX NAMES: XXINPT, XXOUTP, XXTABS WHERE XX 
REPRESENTS THE STANDARD COMPONENT NAME. THE FIRST WORD 
IN EACH LIST WILL CONTAIN THE NUMBER OF WORDS IN THE LIST 
PLUS 1. 

COMMON/CIQ/IREAD,IWRITE,IDIAG 
DIMENSION NAMESU} 

CGMMON/CMSI/MSlll J 
C - — > FORM INDEX 

AINDEX^IOH 

CALL STRMOV(CQMNAM,l,2,AINDEX,l) 

CALL STRM0VtTYPE,l,4,AlNDEX,3) 

C > READ FIRST WORD IN RECORD 

CALL READMS178,N,I,AINDEX) 

C > READ N WORDS 

IF{N.LT.1>N=1 

CALL READHS t78, NAMES, N,AINDEX) 
iF(N.LEol) GO TO 200 

C > SHIFT WORDS OVER ONE TO ELLIMINATE NO. OF WORDS STORED IN IS 

DO 100 1=2, N 
NAMEStI-lJ=NAMES{I) 

100 CONTINUE 
N=N-1 

IFtIOIAG.EQ.80)WRITEtIWRITE,i01HNAMES{I },I=1,NI 

101 FORMAK’J^ CQMDAT-NAMES*/(6A10) ) 

RETURN 

200 N=0 

IFtlDIAG.EQ.SOJWRlTE { IWRITE,20l> 

201 FORMAT(* C0MDAT-N=0=i= ) 

RETURN 

END 


192 


BCS 40262-2 



ooooooooonooooooooo 


CCSORT 

SUBROUTINE CSORT tIA?NN} 

PURPOSE 

CSORT SORTS THE ELEMENTS OF A SINGLE-DIMENSION SINGLE- 
PRECISION ARRAY IN ASCENDING-CHARACTER (DISPLAY CDDE> ORDER, 
WITH A SORT OPTION THAT PLACES BLANK CHARACTERS FIRST IN THE 
ALPHAMERIC SEQUENCE- 
THE SHELL ALGORITH IS USED. 

USAGE 

DIMENSION lAtJ) WHERE J^lABSfNl 

CALL CSQRT(IA,N) 

INPUT PARAMETERS 

lA - INPUT ARRAY TO BE SORTED IN PLACE 
N - lABS(N) IS NUMBER OF ELEMENTS IN ARRAY lA 
N.LT.O PERFORM NORMAL SORT, SEE ABSTRACT 
N.GT.O PERFORM MODIFIED SORT, SEE ABSTRACT 
OUTPUT PARAMETERS 

lA - THE INPUT ARRAY IS SORTED IN PLACE 
USER ERROR 

WHEN N.EQ*0, CONTROL IS RETURNED 70 THE CALLING PROGRAM 
WITHOUT SORTING, 

C 

INTEGER IA(1) 

EQUIVALENCE IITEMP,KHR1) 

DATA IBLANK/55000000000000000000B/ 

C ^ ^ ^ VALIDITY CHECKS 

IF (NN.EQ.Ot GO TO 990 
N = lABSCNN) 

IF (NN.LT.Ol GO TO 300 
C * * * SWITCH CHARACTERS 
KHRl = I BLANK 
KHR2 ^ 0 
LIH = lO^N 
200 K2 = 1 

DO 2X0 J-1,LIM 
N2 “ LIM-K2+1 

I = ISCAN (KHR1,1,1,IA,K2,N2,M1» 

IF {I.EQ.Oi GO TO 220 
CALL PUTT( IA,I,KHR2> 

IF (l.GE.LIMJ GO TO 220 
210 K2 = I+l 

220 IF (KHRi.EQ.O) GO TO 990 
C ^ 4: SORT THE ARRAY 

300 M = N 
320 M = «/2 

IF (M.LE.O) 60 TO 400 
K = N-M 
DO 340 J=l,K 
I = J 

330 II = I+M 

CALL KOMPAR (IA(I],IA(II),ITEMPt 
IF tlTEMP.LE.O) GO TO 340 
ITEMP = lAfl) 
lAM) = lAtllJ 
lA(II) = ITEMP 
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I = I-M 

IF {I.GT.OJ GO TO 330 
340 CONTIMUE 
GO TO 320 

C * * * SWITCH CHARACTERS BACK 
400 IF (HW.LT.O) GO TO 990 
KHRl = 0 
KHR2 = I BLANK 
GO TO 200 
990 RETURN 
END 
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CDUMPPF 

SUBROUTINE DUMPPFiCMPNTS, ICPMAX^MSI jTYPES y AINPUT ) 

C VERSION 1. revised: MAY 21 1976 

C PURPOSE: DUMP PERMANENT FU.E ONTO TAPE 9 IN INPUT FORMAT 

C CALL SEQUENCE: CHPNTS » COMPONENT NAME LIST 

C ICPMAX - NUMBER OF COMPONENTS 

C MSI - MASS STORAGE INDEX ARRAY 

C TYPES - DATA TYPE NAMES 

C AINPUT - NAME ARRAY WORK STORAGE ARRAY 

C DESIGNED BY: J.Do BURROUGHS DEC 1975 

DIMENSION CMPNTSdijMSItU ,TYPESC3),AINPUT{ n 
WRITE C9, ID 

II FORMAT(=i=NEW FILE^J 

C — “ LOAD FILE NAME 

CALL READMS t78 , PFNAME , 1 ,6HPFNAME } 

WRITE£9,65}PFNAME 
65 FQRMATt^FILE NAME=^»A10) 

C «>_> SCAN ALL COMPONENTS 

DO 640 1=1, ICPMAX 
C load COMPONENT NAME 

PINDEX=10H 

CALL STRMQV(CMPNTS{D,1,2,PINDEX, 1) 

C — “> SCAN THREE TYPES OF LISTS REQ D FOR EACH COMPONENT 

DO 620 J=I,3 

CALL STRMDV{TYPEStJ),i,4,PINDEX,3) 

C > READ LISTS FROM FILE 78 

CALL READMS«78,MAXa,PlNDEX) 

CALL README (78, AINPUT, MAX, P INDEX > 

MAXM1=MAX-I 

c '> WRITE INPUT LIST NAME AND NUMBER OF INPUTS tOUTPUTSJ 

WRITE(9, lODPINDEXsMAXMi 
101 FORMATCA7,=5f = 

C — test for TABLE INPUTS 
IF{vt.EQ,.3>G0 TO 200 

C > INPUT AND OUTPUT LIST TYPES 

IF! MAX.GT. D WRITE f 9, 111 ) (AINPUT {ID, K=2, MAX i 

III F0RMAT(8A10> 

GO TO 620 

C > TABLE INPUT FORMAT 

200 IFtMAX*LE-llGO TO 620 
DO 240 K=2,MAX 

CALL GETCODCSjAINPUTtK) ,IDIM) 

DIM=IDIM 

C •> WRITE TABLE NAME AND MAX. DIMENSION 

WRITEC9,201iAINPUT£K»,DIM 

201 FDRMAT(A3,Fr'.0) 

240 CONTINUE 

620 CONTINUE 

C > TEST FOR SYMBOL NUMBER 

IFtK0MSTRtCHPNTSin»9,2,2H ,D*EQ*0)G0 TO 640 

C > get symbol NUMBER FROM COMPONENT NAME 

CALL GETC0D(5,CMPNTStI),ISYM8) 

WRITE £9,631 J.CMPNTS( I DISYMB 
631 FORMAT{*SYMBOL, - =f=,I5J 

640 CONTINUE 
RETURN 
END 
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C FI LOAD 

PROGRAM FlLQADtINPUT-lOOsDUTPUT-200,TAPe5“INPUT,TAPE6=OUTPUTf 
1 TAPE3FTAPE78,TAPE79^,TAPE9) 

VERSION 4. REVISED JUNE 24 1977 

purpose: this PROGRAM ADDS INPUTfOUTPUT>AND TABLE NAME LISTS 

TO THE EASY PROGRAM PERMANENT FILE. 
method: data IS READ FROM TAPE3 AND LOADED INTO THE PERMANENT FILE. 

THE DATA FORMAT IS: FIRST PHRASE -RECORD NAME. 

SECOND PHRASE = NO. WORDS IN RECORD 
THE INPUT AND OUTPUT NAME LISTS INPUT 
DATA IS FIXED FIELD WITH A 8A10 FORMAT. 

THE TABLE LIST INPUT DATA IS AlOjGB.O 
FORMAT. 

THE NUMERIC INPUT SPECIFIES THE MAXIMUM 
TABLE DIMENSION. NEGATIVE VALUES 
INDICATE SINGLE INDEPENDENT VARIABLE TABLES. 

DESIGNED by: J .D. BURROUGHS MAY 1974 

DIMENSION NAMES { 100> ,MS I ( 897 ) ,CMPNTS { 151 ) ? AINPUT {63> *OUTPUT{ 63 ) , 

1 TABLE C16 MSI2 1 897>, ICQM t BU TYPES ( 3), CHMNDSC 61 » ICMM0D1151) 
COMMON/ClO/IREAD,IWRITEf IDIAG 
EQUIVALENCE t ICMPl ,CMPNTS 1 

DATA COMNAM/XOH /, TYPES/30H1NPT OUTP TABS 

1 / 

DATA CMHNDS/60HLIST STANDPURGE DUMP FILE SYMBOL NEW FILE F ' 
IILE NAME / 

DATA TYPE/lOri /, LIST/0/, ICPMOD/O/, ICMMAX/6/, ICPMAX/-1/ 

IRBAD=5 
IWRITE=6 
IDIAG=0 

C > open mass STORAGE FILE 

CALL 0PENMS178,MSI,397, 1) 

CALL QPENMSt79,MSI2(fB97,l) 

C > read command CARD 

100 READ13, lODICDM 

101 FORMATtSAlOl 
IF(EOF(3))500,120 

120 INDEX=1 

C > LOCATE NEXT PHRASE 

CALL NXTPHdCOM, INDEX, PINDEX ) 

IF(PINDEX.EQ.10H IGO TO 100 

C > SEARCH COMMAND LIST 

CALL LCMPH { PINDEX, CMMNDS , ICMHAX, 1 , NTASKl 

Q .> branch TG 300 IF COMMAND IS IDENTIFIED 

IFtNTASK.NE.OlGQ TO 300 

C > TEST IF COMPONENT NAME LIST HAS BEEN READ 

IFCICPMAX.LT.OIGO TO 400 

C > GET LIST TYPE 

130 CALL STRMDVtPINDEX,3,4,TYPE,l) 

C > COMPARE TYPE TO 3 ACCEPTABLE TYPES 

CALL LCMPH (TYPE, TYPES, 3, ItITYPEI 

C > TEST IF TYPE WAS IDENTIFIED 

IFtITYPE.EQ.OlGQ TO 160 
L0A0=1 

C — > get COMPONENT NAME 

CALL STRM0V(PINDEX,l,2,C0MNAM,li 
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Q BYPASS SEARCH IP COMPONENT COUNT < 1 

IFtlCPHAX.LT.DGO TO 136 

C > SEARCH COMPONENT NAME LIST 

DO 132 NCOHP=l,ICPMAX 

IF(KOMSTRtCMPNTStNCOMP) Tl»2?CDMNAMel) .EQ.O)GO TO 140 

132 CONTINUE 
C "> NEW COMPONENT 

136 ICPHAX=ICPMAX-M 
NCOMP=ICPMAX 

C > add component NAME TO LIST 

CHPNTSf ICPMAX)=COMNAM 
WRITE{6, 137)C0HNAM 

137 FDRMAT(3X»A4,=«^WILL BE ADDED AS A NEW COMPONENT^^) 

C LOAD NAME ARRAYS WITH DEFAULT VALUES OF 0 NAMES 

VALUE=COMNAM 
DO 138 I=l?3 

C ADO TYPE NAME TO COMPONENT NAME 

CALL STRMQ V C T YP ES ( I ) » 1 , 4 , VALUE 1 3 ) 

NAMES ( 1 ) -1 

CALL WRITMS(78,NAMES*l*VALUE» 

138 CONTINUE 

C BYPASS SEARCH IF MODIFIED COMPONENT COUNTER = 0 

140 IFtICPMOD.EQ.O)GQ TO 146 

Q > jest IF COMPONENT HAS BEEN MODIFIED BEFORE 

DO 144 IssljICPMOD 
J=ICHMODfI) 

IF(R0MSTR(CDMNAM,1,2,CMPNTS(J ),1) .EQ.OJGO TO 150 
144 CONTINUE 
146 ICPMOD^ICPMOD+l 

C > ACCUMULATE COMP. NOS. OF COMPONENTS MODIFIED 

ICMMODf ICPMOD>=NCOMP 

C > GET NEXT PHRASE WHICH CONTAINS NO. OF ITEMS IN LIST 

150 CALL NXTPHlICOM*INDEX,PHRS) 

C > TEST FOR NUMERIC FIRST CHARACTER 

CALL NUMERCiPHRS), RETURNS (180) 

C > CONVERT HQLLORITH TO INTEGER 

GALL BCDREL(VALUEfPHRS) 

N^VALUE 
GO TO 200 

160 WRITEt 6 , I 6 IJPINDEX 1 TYPE 

161 F0RMATI/22H WARNING IN ,A8,2X»A6, 

l^ISN T A RECOGNIZED NAME LIST TYPE- NAME LIST WILL NOT BE LOADED»>: 
1 ) 

LOADED 
GO TO 150 

130 WRITEt6s 18DPHRS 

181 F0RMATt/16H WARNING *’J'=4=,A10» 

1=^^ISN T A VALID NUMBER OF NAMES FOR NAME LIST ^ 

2«NAME LIST WILL NOT BE LOADED^") 

GO TO 100 
200 N=N+l 

IF(N.LE.l) GO TO 220 
IF(TYPE.EQ.TYPES(3)1G0 TO 210 

C > READ NAMES FROM TAPES 

READ(3,101) (NAMESm*I=2,N) 

GO TO 220 
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c > READ TABLE NAHES 

210 DO 215 1=2, N 
READt3T211>NAHES{I>tDIM 

211 FDRMATC A3,G7.0) 

IDIM=DIM 

CALL PUTCODt5,NAMES6n,lDIM) 

215 CONTINUE 
220 IFCN.LT.liN=l 
NAMES! 1J=N 

C > WRITE NAMES ON MASS STORAGE PERMANENT FILE 

IF{L0A0*£Q.1)CALL WRITHS ( 78 ,NaMES ,N,P lNDEX) 

GO TO 100 

C > COMMAND INTERPRETATION 

300 GO 10(310,320,400,320,700,750) ,NTASK 

C =L^==s===s :======-====== list standard COMPONENTS === NTASK =1 

310 LIST-1 

GO TO 100 

C =«^:====r============= PURGE NTASK = 2 OR SYMBOL == NTASK = 4 

320 IF( ICPMAX.LT.O)GO TO 400 

C •> GET COMPONENT NAME 

330 CALL NXTPHdCOM, INDEX, COMNAM) 

IFCCOMNAM.EQ.IOH )G0 TO 100 

C > LOCATE NAME XN COMPONENT NAME LIST 

DO 336 NCDMP=1,ICPMAX 

IF(KOMSTR(CMPNTS(NCOMP) ,1,2, COMNAM, 1).EQ.O)GO TO 338 
336 CONTINUE 
NC0MP=0 
GO TO 360 

338 IF(NTASK.NE«2)GD TO 350 

C > MOVE COMPONENT NAMES OVER ONE TO OVERWRITE PURGED NAME 

DO 340 I=NCOMP,ICPMAX 
340 CMPNTS(I)=CMPNTS(I+l) 

C > REDUCE NO. OF COMPONENTS 

ICPMAX=ICPMAX-i 
GO TO 330 

350 CALL NXTPHdCOM, INDEX, SYMB) 

CALL BCDREL(SYMB,SYMB) 

ISYMB=SYMB 

CALL PUTC0D(5,CMPNTS(NC0MP) ,ISYMB) 

ICPMOD-ICPMOD-M 
ICMMODCICPMDD)=NCOMP 
GO TO 330 

360 WRITE(6,361)C0MNAM 

361 F0RMAT(/33H WARNING *** CAN T IDENTIFY ,A4» 
l*AS A STANDARD COMPONENT*) 

GO TO 330 

C > GET COMPONENT NAME LIST FROM FILE 78 

400 CALL READMSf78,ICPMAX,l,6HCMPNTS) 

CALL READMS£78,CMPNTS,ICPMAX,6HCMPNTS) 

C “> SHIFT NAMES OVER 1 WORD TO ELLIMINATE N0« OF WORDS 

DO 420 I=2,ICPMAX 
420 CMPNTS( I-l)=CHPNTSd ) 

ICPMAX-ICPMAX-I 
IFCNTASK.L£.0)60 TO 130 
GO T0d30,330, 720, 330, 130), NTASK 
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c > list cgmponemts modified if LIST=1 

500 MAXCOM-ICPMOD 

IFdlST.NE.l^GO TO 600 

> XF NO COMPS. MODIFIED, SKIP LISTING 

IFtMAXCOM.LE.OiGO TO 600 

C > SCAN COMPONENTS SPECIFIED 

00 560 I=1,MAXCDM 
J=I 

J=ICMMOD(I) 

COMNAM=CMPNTS(JJ 

520 CALL GETC0D(5,C0MNAM,ISYMB) 

WRITE(6,521) IrCOHNAM, ISYMB 

521 FORMAT (//^COMPONENT NO-*, 13,* NAME = *,A2,* SYMBOL NO. = *,13/ 
I* INPUTS*,7X,*0UTPUTS*,6X,*TABLES*,7X,*DIHENSIQN*) 

C > GEX INPUT, OUTPUT, AND TABLE NAMES 

CALL C0MDAT{C0MNAM,4HINPT,NI,AINPUT) 

CALL COMDATtCOMNAMjAHDUTPtNQ, OUTPUT) 

CALL C0MDATtC0MNAH,4HTABS, NT, TABLE) 

HAX=MAX0CNI»N0,NT,1) 

C > SCAN LONGEST LIST OF NAMES 

DO 550 J=1,MAX 

C > BLANK NAMES 

AIN=10H 

OUT=10H 

TAB=10H 

1D=10H 

IFt J-LE-NIlAlN=:AlNPUnU) 

XFtJ.LE.NO)OUT-OUTPUT( J) 

IF( J.GT.NT)GO TO 540 
TAB=TA8LEU) 

C > GET TABLE DIMENSION 

CALL GETCODt 5,TA8,ID) 

540 WRITE{6,541>AIN,0UT,TAB,ID 

541 FORMATt2X,A10,3X,AlO,3X,A8,5X,I4) 

550 CONTINUE 

560 CONTINUE 

C > DEGAS MASS STORAGE FILE 

C > IF NO COMPONENTS EXIST, CAUSE ABEND TO PREVENT DEGASSING 

600 AINs=-l- 

IFaCPMAX-LE.O)I=SQRTCAIN) 

C SORT COMPONENTS INTO ALPHABETICAL ORDER 

CALL CSORT(CMPNTS,ICPMAX> 

C > SCAN ALL COMPONENTS 

DO 640 I-1,ICPMAX 

Q > load COMPONENT NAME 

PINDEX=10H 

CALL STRMOVICMPNTS(I) ,1,2,PINDEX,1) 

C > SCAN THREE TYPES OF LISTS REQ D FOR EACH COMPONENT 

DO 640 Js=l,3 

CALL STRM0VITYPES{J>,1,4,PINDEX,3) 

C “> READ LISTS FROM FILE 78 

CALL READMS178,MAX,1bPINDEX) 

CALL READMS<78,AINPUT,MAX,PINDEX) 

C > WRITE LISTS ONTO FILE 79 

CALL WRITMSt79,AINPUT,MAX,PINDEX) 

640 CONTINUE 
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C > SHIFT CQMPQNEr^T NAMES OVER 1 WORD 

J=ICPMAX 

DO 660 I=1»ICPMAX 
CMPNTSt J-5-l)=CMPNTS£J> 

660 J=J-1 

C > ADD NO. OF COMPONENTS ■»' 1 AS FIRST WORD IN LIST 

1CMP1=ICPMAX+1 

C > STORE COMPONENT NAME LIST 

CALL WRITMSt79,CMPNTSrlCMPl,6HCMPNTSi 

C STORE PFNAME 

CALL RE ADMS { 78 , PFNAM E , 1 » 6H PFNAME J 
CALL WRITMSt79, PFNAME, l,6HPFNAMEl 
STOP 

c ===:s™=== new file === NTASK = 5 
700 ICPMAX=0 
GO TO 100 

C ==^======:= dump FILE === NTASK = 3 

720 CALL DUMPPF{CMPNTS»ICPHAX,MSI»TYPES,AINPUT) 

GO TO 100 

C =======—= file name =- NTASK = 6 

750 CALL NXTPHdCOM, INDEX, PFNAME) 

CALL WRITMS ( 78 , PFNAME , 1 , 6HPFNAME ) 

GO TO 100 
END 
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CGETCOD 

SUBROUTINE GETCQD { N» I ARRAY , ICODE ) 
purpose: retrieve a 4 DIGIT CODE, VALUE OF CODE MUST BE BETWEEN 

2047 , STORED 5 CODES/WORD, FROM AN ARRAY OF PARAMETER 
CODES, THIS ROUTINE IS USED TO REDUCE THE STORAGE REQUIRED 
TO STORE THE I/O CODE LISTS FOR EACH ANALYSIS MODULE. 

CALL SEQUENCES N LOCATION OF CODE IN ARRAY lARRAY 5 CODES/WORD • 

lARRAY INTEGER ARRAY WHICH RECIEVES CODE NUMBER. 
ICODE VALUE OF CODE INPUT 70 ROUTINE. 

DIMENSION lARRAY m 
DATA MASK/7777B/ 

C DETERMINE WHICH WORD IN ARRAY CONTAINS THE NTH CODE. 

IW0RD=(N-l}/5+l 

C DETERMINE THE NUMBER OF BITS TO SHIFT CODE TO RIGHT MOST 12 BITS. 

I SH I FT= { MO D ( N« 1 , 5 ) -4 H 1 2 
C SHIFT CODE BITS TO RIGHT HAND POSITION. 

ICQDE=SHIFT{ lARRAYf IWORDi , ISHIFTt 
C MASK OUT UNWANTED BITS TO LEFT OF CODE. 

ICODE=M ASK. AND. ICODE 
C TEST SIGN BIT. 

IFUC0DE.LT.2048) RETURN 
C RESTORE 1 BITS FOR NEGATIVE CODE- 
ICDDE=ICODE.OR..N.MAC'K 
RETURN 
END 
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G6TT 


IDENT GETT 

ENTRY GETT 

+ VFD 18/0HGET»4a/3 

GET BSSZ 1 

GETT EQU GET 

SB4 E^g-1 .. INITIALIZE MULTIPLE OF 10 COUNTER. 

SA4 A1-B4 

SA2 X4 . PUT I IN X2. 

LOOP SB4 64+1 . COUNT MULTIPLES OF 10. 

SX2 X2-10 . SUBTRACT 10 FROM I. 

ZR X2,0K . IF X2 .LE. 0, EXIT FROM LOOP. 

PL X2,LQ0P . LOOP UNTIL NO MORE MULTIPLES OF 10 IN I. 

OK SA4 X1+B4 . LOAD WORD CONTAINING ITH CHAR. OF S. 

MX7 6 » 

SA5 SIX 

SX2 X2+9 . X2 = POSITION IN S WORD. 

PX2 B0,X2 . PACK X2 

DX2 X2^X5 . MULTIPLY BY SIX 

SB2 X2 

LX4 B2»X4 . LEFT ADJUST ITH CHARACTER. 

SA5 HASK2 

BX6 XA’S'XT . MASK OUT REMAINDER OF WORD. 

6X6 X5+X6 . FILL X6 WITH BLANKS. 

SA4 A 1+2 

SA6 X4 . STORE IN T. 

EO BO, BO, GET 

MASK2 DATA 005555555555555555556 

SIX DATA 20000000000000000006B 

END 
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IDENT ISCAN 


WRITTEN BY TDM BAKER* EOT SUPPORT PHONE 655-6509 


12/1/70 


* THIS IS A COMPLETE REWRITE OF THE OLD SYSTEM ROUTINE. 

=4' DIFFERENCES - 9 TO 15 TIMES FASTER 

* - CALLS NO SUBPROGRAMS (USED TO CALL KDMSTR) 

^ - HAS A SPECIAL LOOP FOR THE CASE WHERE THE 

* STRING 2 SET IS ONLY ONE CHARACTER 

* CALLING SEQUENCE J2=ISCAN ( SI * II ,N1 * S2, 12,N2, J1 ) 

* SI - STARTING ADDRESS OF THE FIRST STRING 

* II “ CHARACTER POSITION IN Si OF FIRST CHARACTER TO BE COMPARED 

^ N1 - THE NUMBER OF CHARACTERS IN SI TO BE COMPARED. IF N1 

IS NEGATIVE, THE SCAN IS RIGHT-TO-LEFT IN SI. 

* S2 - STARTING ADDRESS OF THE SECOND STRING 

^ 12 “ CHARACTER POSITION IN S2 OF FIRST CHARACTER TO BE COMPARED 

* N2 - THE NUMBER OF CHARACTERS IN S2 TO BE COMPARED. 

^ J1 - OUTPUT, CHARACTER POSITION IN SI WHERE A MATCH WAS FOUND 

* J2 - OUTPUT, CHARACTER POSITION IN S2 WHERE A MATCH WAS FOUND 

* Jl=J2-0 NO MATCH WAS FOUND 

’J' J1=J2--1 INPUT ERROR 


ENTRY ISCAN 

VFD 30/OLlSCAN,30/7 

ISCAN BSS2 1 

MXO 52B 

SX6 AO 

SA6 SAVEAO 

SAO A1 

SA2 AO+1 

SA2 X2 

SA4 AO+4 

SA4 X4 

ZR X2, ERROR 

NG X2, ERROR 

SA5 AO+2 

SA2 A 0+5 

SA5 X5 

SA2 X2 

2R X A, ERROR 

NG XA, ERROR 

. ZR X5, ERROR 

ZR X2, ERROR 

NG X2, ERROR 


SAVE AO OF CALLING PROGRAM 

SET UP AO FOR USE BY ISCAN 
FETCH THE FIRST STRING STARTING 
CHARACTER POINTER (ID 
FETCH THE SECOND STRING STARTING 
CHARACTER POINTER (12) 

II MUST BE A NON-ZERO 
POSITIVE NUMBER 


GET THE VALUE OF N1 
GET THE VALUE OF N2 
12 MUST BE A NON-ZERO 
POSITIVE NUMBER 
N1 MUST NOT EQUAL ZERO 
N2 MUST BE A NON-ZERO 
POSITIVE NUMBER 


>4: A LEGITIMATE REQUEST HAS BEEN MADE - PROCEED 


X5 

X2 

73B 

77B 

-X1-X5 

X6 

6 

X6,S1 


ai CONTAINS THE VALUE OF N1 
B4 CONTAINS THE VALUE OF N2 
XI CONTAINS A MINUS ONE 
FILL X5 WITH THE SIGN BIT OF N1 
X6 CONTAINS A ONE WITH THE SIGN OF N1 
86 CONTAINS A ONE WITH THE SIGN OF N1 
B7 WILL BE USED TO CONTROL THE LEFT 
SHIFT OF STRING ONE - 6 BITS AT A 
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SB7 5 ^ 

SAB TEN 

SA2 TENTH 

SB3 XI 

SXA X4+B3 

PX4 B0,X4 

NX6 85*X4 

FX6 X6*X2 

liX6 85 tX& 

SA5 AO+3 

LX6 B5,X6 

1X7 X5+X6 

SA7 W1S2 

PX6 50jX6 


DX6 X6>S=X3 

UX6 B5,X6 

1X6 X4-X6 

SA5 SIX 

DX6 X6^X5 

UX6 B5,X6 

SA6 WIS2P 

SA4 AO+l 

SA4 X4 

SX4 X4+B3 

PX6 BO,X4 

MX6 B5,X6 

SAl AO 

FX6 X6+X2 

UX6 B5sX6 

LX6 35, X6 

SB5 XI 

SAl X6+B5 

PX6 B0,X6 


DX6 X6=^:X3 

UX6 B5,X6 

1X6 X4’-X6 

PX7 B0,X6 

SB2 B2-B2 

LT B6,B0,SM 

DX5 X7=*‘X5 

IK7 X3-X7 

SB5 X5 

EQ S 

KX4 73 B 

DX5 X7*X5 


TIME IF Ml 1“^ +VE, 54 BITS IF -VE 
A PACKED UNNORI'iAl.IZED DECIMAL TEN 
A FLOATING POINT TENTH 
B3 CONTAINS A MINUS ONE 

12-1 AS A PACKED UNNDRMALIZED NUMBER 

NUMBER OF WORDS STARTING POINT IS 
PAST THE LOCATION OF S2 


CALCULATE STARTING ADDRESS OF THE 
SECOND STRING AND STORE IN W1S2 
X6 CONTAINS THE NUMBER OF WORDS THAT 
THE STARTING POINT IS PAST THE 
LOCATION OF S2 AS A PACKED 
UNNORMALIZED NUMBER 

CALCULATE THE 

CHARACTER POSITION MINUS ONE 
OF THE FIRST CHARACTER IN S2, 
MULTIPLY IT BY SIX, AND STORE THE 
RESULTING BIT SHIFT COUNT 
IN W1S2P 

FETCH THE FIRST STRING STARTING 
CHARACTER POINTER (ID 

Il-l AS A PACKED UNNORMALIZED NUMBER 

FETCH LOCATION OF SI 
NUMBER OF WORDS STARTING POINT IS 
PAST THE LOCATION OF SI 


XI CONTAINS THE FIRST WORD IN SI 
TO BE CHECKED 

X6 CONTAINS THE NUMBER OF WORDS THAT 
THE STARTING POINT IS PAST THE 
LOCATION OF SI AS A PACKED 
UNNORM ALiZ ED NUMBER 

CALCULATE THE 

CHARACTER POSITION MINUS ONE 
OF THE FIRST CHARACTER IN SI 


LEFT TO RIGHT SCAN OF SI WAS 

REQUESTED, CALCULATE INITIAL VALU^ 
OF SI POSITION IN WORD INDEX 
AND SET UP B5 FDR INITIAL 
SHIFTING OF FIRST SI WORD 
RIGHT TO LEFT SCAN OF SI WAS 

REQUESTED, CALCULATE INITIAL VALUE 
OF SI POSITION IN WORD INDEX 
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SHXl 


* 


SMX2 




ES2S 

* 

fi: 

* 

54 : 


* 

S21C 


UX5 

B5,X5 

AND SET UP B5 FOR INITIAL 

SB5 

X5-48 

SHIFTING OF FIRST Si WORD 

I XT 

X6-X4 


GE 

B5*B0,S 


SB5 

B5'^60 


MXO 

66B 

SET UP CHARACTER MASK 

LXl 

B5,X1 


MX6 

73 B 

X6 CONTAINS A MINUS ONE 

SB3 

B3+B4 

IF STRING 2 IS ONE CHARACTER LONG* 

EQ 

B3,B0,S21C 

GO TO SPECIAL LOOP 

SX5 

10 


LXl 

87*X1 

FETCH NEXT (OR FIRST) CHARACTER FROM 

SB2 

B2+B6 

SI* INCREMENT SI CHARACTER POSITION 

1X7 

XT+X6 

INDEX* DECREMENT SI POSITION IN 

BX3 

-X0=4^X1 

WORD INDEX, ISOLATE NEXT CHARACTER 
IN SI 

SA2 

W1S2 

FETCH S2 POINTERS 

SA4 

W1S2P 


SA2 

X2 


SB3 

X4 


LX2 

B3*X2 

PREPARE TO EXTRACT FIRST CHARACTER 

SB 5 

B5-B5 

FROM S2 STRING 

SB3 

B3-60 


LX2 

6 

SHIFT NEXT CHARACTER IN S2 STRING TO 
RIGHTMOST POSITION IN X2* 

SB5 

B5+1 

INCREMENT S2 CHARACTER INDEX* 

BX4 

~X0*X2 

EXTRACT NEXT CHARACTER FROM S2 

SB3 

B3+6 

INCREMENT S2 POSITION IN WORD INDEX 

BX4 

X3-X4 

AND COMPARE THE TWO CHARACTERS 

ZR 

X4* HATCH 

IF THE CHARACTERS MATCH, GO TO MATCH 

EQ 

B4,B5,ES2S 

IF THE END OF THE S2 STRING HAS BEEN 
REACHED* GO TO ES2S 

LT 

B3,B0,SMX2 

IF THERE ARE MORE CHARACTERS IN THE 


CURRENT S2 WORD TO BE COMPARED* 

GO BACK TO SMX2 AND WORK ON THE 
NEXT CHARACTER IN S2 
OTHERWISE* GET THE NEXT WORD IN S2 
INITIALIZE THE POSITION IN WORD 
INDEX AND GET BACK TO WORK ON S2 
IF ALL THE CHARACTERS IN SI HAVE 
BEEN CHECKED* GO TO NM (NO MATCH) 
OTHERWISE* CHECK TO SEE IF THE 
CURRENT WORD IN XI HAS ANYMORE 


NZ 

X7,SMX1 

CHARACTERS LEFT TO CHECK, IF SO, 

GO GET THE NEXT CHARACTER. IF NOT* 

SAl 

A1+B6 

GET THE NEXT WORD IN SI, INITIALIZE 

BX7 

X5 

THE POSITION IN WORD INDEX AND 

LT 

B0,B6*SMXl 

RETURN. NOTE THAT IF THE SCAN IS 

LXl 

6 

RIGHT TO LEFT, AN EXTRA SHIFT IS 

EQ 

SMXi 

REQUIRED WHICH NEUTRALIZES THE 
SHIFT AT SMXI. 

SA2 

WIS2 

SPECIAL ONE CHARACTER STRING 2 LOOP 

SA4 

W1S2P 

FETCH THE S2 POINTERS 

SA2 

X2 


SB3 

X4-4-6 


LX2 

B3,X2 


SB5 

34 



SA2 A2+1 

SB3 ~6Q 

EQ SMX2 

EQ B2*B1*NM 
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i 

BX4 



-X0*X2 

EXTRACT THE S2 CHARACTER 

1 . 

SX5 

10 


i SMXllC 

LXl 

BTtXl 

FETCH NEXT (OR FIRST) CHARACTER FROM 

; 

SB2 

B2+B6 

Sit INCREMENT SI CHARACTER POSITION 


1X7 

X7+X6 

INDEXt DECREMENT SI POSITION IN 


BX3 

-X0*X1 

WORD INDEX, ISOLATE THE NEXT 


BX3 

X3-X4 

CHARACTER IN SI? COMPARE IT WITH 


IR 

X3, MATCH 

THE S2 CHARACTER AND IF THE 




CHARACTERS MATCH, GO TO MATCH 


EQ 

B2tB1tNM 

IF ALL THE CHARACTERS IN SI HAVE 




BEEN CHECKED, GO TO NM (NO MATCH) 

\ ^ 



OTHERWISE, CHECK TO SEE IF THE 

'' * 



CURRENT WORD IN XI HAS ANYMORE 

i 

( 

NZ 

X7, SMXllC 

CHARACTERS LEFT TO CHECK.. IF SO, 

1 * 



GO GET THE NEXT CHARACTER. IF NOT, 

i 

SAl 

A l-J-BB 

GET THE NEXT WORD IN Si, INITIALIZE 

* . i 

BX7 

X5 

THE POSITION IN WORD INDEX AND 


LT 

BO, B6, SMXllC 

RETURN. NOTE THAT IF THE SCAN IS 


LXl 

6 

RIGHT TO LEFT, AN EXTRA SHIFT IS 

1 

EQ 

SMXllC 

REQUIRED WHICH NEUTRALIZES THE 

i ^ 



SHIFT AT SMXllC. 

\ NM 

SAl 

AO-i-6 

ND MATCH WAS FOUND 

.1 

SX6 

B5-B5 

SET Jl AND J2 EQUAL TO ZERO 

I 

SA6 

XI 

AND RETURN 

. 1 ■ 

SAl 

SAVEAO 

RfSTORE THE CALLING PROGRAMS 

j 

SAO 

XI 

AO REGISTER 


EQ 

B4,B4,ISCAN 


MATCH 

SA2 

AO+1 

A MATCH HAS BEEN FOUND- 


SAB 

A 0+4 

Jl IS RETURNED AS THE POSITION IN 




SI OF THE MATCH. ( Jl+I 1+B2-B6 ) 

i 

SB3 

B2-B6 

J2 IS RETURNED AS THE POSITION IN 


SAl 

A 0+6 

S2 OF THE HATCH, (J2=I2+B5-1) 

i 

SA2 

X2 


1 

SB4 

85-1 


r 

SA3 

X3 



SX7 

X2+B3 



SX6 

X3+B4 


j 

SAT 

XI 


' 

SAl 

SAVEAO 

RESTORE THE CALLING PROGRAMS 


SAO 

XI 

AO REGISTER 


EQ 

BItBItISCAN 


ERROR 

SAl 

AO+6 

AN ERROR HAS BEEN FOUND IN THE INPUT 


MX6 

736 

REQUEST. Jl AND J2 ARE RETURNED 

t 

SA6 

XI 

AS MINUS ONE. 

; 

SAl 

SAVEAO 

RESTORE THE CALLING PROGRAMS 


SAO 

XI 

AO REGISTER 


EQ 

B1,B1,ISCAN 


SAVEAO 

BSSZ 

1 

STORAGE FOR CALLING PROGRAMS AO 

W1S2 

8SS 

1 

ADDRESS OF WORD CONTAINING FIRST 




CHARACTER IN S2 TO BE CHECKED 

W1S2P 

BSS 

I 

POINTER TO CONTROL SHIFT OF FIRST 

* 



WORD IN S2 TO PROPERLY POSITION 

* 



THE FIRST CHARACTER FOR CHECKING 

TENTH 

DATA 

.1 

A FLOATING POINT TENTH 

TEN 

DATA 

020000000000000000012 A PACKED UNNORMALIZED TEN 

SIX 

DATA 

□20000000000000000006 A PACKED UNNORMALIZED SIX 

END 
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KQMPAR 





IDENT 

KOHPAR {StT,I} 










SUBJECT: 

COMPASS SUBROUTINE KQMPAR 





* 

AUTHORS: 

ANDERSONt 0. L« - LA ROWE, E. 

♦ 



BCS 6600 METHODS GROUP - 22 FEBRUARY 197X 

* 





PURPOSE: 

TO PERFORM A 60 BIT LOGICAL COMPARE OF TWO WORDS 






USAGE: 

CALL KOMPAR {S,T,IJ 

it: 



I = KOMPAR (S,T,I) 








WHERE 

# 

INPUT 


it: 




it: 



S = FIRST STRING WORD 




T = SECOND STRING WORD 






OUTPUT 









I = “1 IF S < T 

* 



= 0 IF S - T 

* 



= 1 IF S > T 

it: 


ENTRY 

KOMPAR 



VFD 

36/0LK0MPAR,2A/3 

* 




KOMPAR 

BSSZ 

1 ENTRY/EXIT - KOMPAR 



SA5 

XI GET S 



MX7 

1 



SA2 

Al+1 



SA2 

X2 GET T 



LX5 

59 



BX3 

-X7*X5 



LX2 

59 



BXA 

~X7*X2 



MX6 

59 



SAl 

Al+2 



1X7 

X3-X4 LEFT PARTIAL DIFFERENCE 



NG 

X7,K0MPAR1 IF S < T 



BX6 

-X6 



NZ 

X7,K0MPAR1 IF S > T 

it; 




t 



LEFTMOST 59 BITS ARE EQUAL. TEST RIGHTMOST ONES 



1X6 

X5-X2 



LX6 

1 

KQMPAR 1 

SA6 

XI STORE I 



EQ 

KOMPAR RETURN 

5{C 




* 




:{; 


END 
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KOMSTR 

IDENT KOMSTR .CALL KOMSTRCSA*LA*NATSBrLB> 

* KOMSTR REVISED TO ECONOMIZE ON FIELD LENGTH, EXECUTION TIME. 

REVISED BY BRUCE BAILEY 

* BCS SCIENTIFIC SYSTEMS 

COMPARES CHARS LA THRU LA+NA-1 OF SA TO CHARS LB THRU LB+NA-1 
OF SB ALPHANUMERICALLY. RETURNS - 0 + AS SA LT EQ GT SB. 


ENTRY KOMSTR 

+ VFD 36/0HKDMSTR,2A/5 

KOMSTR PS 



SBl 

1 



SA4 

Al+Bl 



SA2 

AA+Bl 



SA4 

XA 

LA 


SA2 

X2 

NA 


SA3 

Al+A 



MX6 

0 

INIT VALUE 


SA3 

X3 

LB 


ZR 

XA, KOMSTR 



NG 

XA, KOMSTR 



ZR 

X2, KOMSTR 



NG 

X2, KOMSTR 



ZR 

X3, KOMSTR 



NG 

X3, KOMSTR 







INPUT OK 

- START LOADING 

REGISTERS. 


SB7 

ao+11 



SB2 

XA 

LA 


SS6 

B7”B1 



LT 

B2,B7yV20 


VIO 

SXl 

Xl+Bl 

ADR OF FIRST SA WORD 


S82 

B2-B6 

CHAR COUNT (SAC) 


GE 

B2,B7»V10 


\tZQ 

SB3 

B2+B2 

2*SAC 


SAA 

Al+3 



SB2 

B3+B3 

A*SAC 


SAl 

XI 

INIT VALUE (XI AND A1 ) 


SB3 

B24-B3 

6^SAC 


SB2 

B3-60 

6>J=SAC-60 


SB5 

X3 

LB 


SB2 

B0-B2 

60'-6=S'SAC, THE INIT VALUE 


LT 

B5,B?#VA0 


V30 

SX4 

XA+Bl 

ADR OF FIRST SB WORD 


SB 5 

B5-B6 

CHAR COUNT (SBC) 


GE 

B5,B7»V30 



SB7 

B5+B5 

2HtSBC 


SB5 

B7+B7 

A5S«SBC 


MXO 

5A 

INIT VALUE 


SB7 

85+B7 

6*SBC 


SA4 

XA 

INIT VALUE CXA AND AA> 


SB5 

B7-60 

6*S8C~60 
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SB3 

XZ 

INIT VALUE (NA) 


SB5 

50-B5 

60-6*SBC, THE INIT VALUE. 


SB7 

BO+6 

INIT VALUE 


SB4 

BO+54 

INIT VALUE 

sic* 




** 

IN- 

STACK EXECUTION LOOP- 


** 




V50 

AX2 

XI, B2 

SA WORD 


BX2 

“X0*X2 

SA CHAR 


SB3 

63-Bl 



AX5 

X4,B5 

SB WORD 

i 

BX5 

“XO=i=X5 

SB CHAR 

i 

1X7 

X2-X5 


j 

SB2 

B2-B7 

SA SHIFT COUNTER. 

I 

N2 

XTtALMDST 

■ ' 

i 



INCREMENT COUNTERS. 


EQ 

B3,B0,K0MSTR 

IF EQUAL STRINGS. 

j 

GE 

B2,B0,V60 

IF RESET NOT YET NECESSARY. 

i 

SAl 

Al+Bl 

NEXT SA WORD, ALSO RESET Al. 

j 

SB2 

B4 

RESET COUNTER 

V60 

SB5 

B5-B7 

SB SHIFT COUNTER 

j 

GE 

B5,B0,V50 

IF RESET NOT YET NECESSARY. 

! 

SA4 

A4+B1 

NEXT SB WORD, ALSO RESET A4. 

i 

SB5 

B4 

RESET COUNTER 


EQ 

V50 

KEEP LOOKING. 

1 ALMOST 

SX6 

B1 


1 

PL 

X7,KQMSTR 


1 

1 

BX6 

-X6 



EQ 

KQMSTR 



END 





i 
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CLCMPH 

SUBRQUT IME LCMPH ( IPHRS > ICOML» ICLW AK ? I CLHIN^ LOC } 
purpose: locate PHRASE IN STRING OF COMMAND PHRASES 

CALL SEQUENCE: IPHRS - PHRASE TO BE IDENTIFIED 

ICOML “ LIST OF COMMAND PHRASES 
ICLMAX “ MAX. NO- OF COMMAND PHRASES TO SEARCH 
ICLMIN ~ MIN. NO- OF COMMAND PHRASES TO SEARCH 
LOG “ LOCATION OF IPHRS IN ICOML 
(LDC = 0 IF PHRASE NOT FOUND) 

DESIGNED by: J-D. BURROUGHS OCT 1973 

DIMENSION ICOML {ICLMAX) 

IF( ICLMIN -UT.1)ICLM1N=1 
IF( ICLMAX. LT. ICLMIN) ICLMAX=ICLMIN 
==========: assure THAT SEARCH STARTS BETWEEN ICLMIN AND ICLMAX 

IFILOC-LT. ICLMIN. DR-LOC-GT. ICLMAX )LDC=ICLMIN 
STARTING POINT OF SEARCH 

LOCS=^LOC 

00 IFtlPHRS-NE.ICOMLtLQC) ) GO TO 300 
RETURN 

00 LOC=LOC-M 

======= return TO START IF LAST COMMAND PHRASE IS REACHED 

IF C LOG. GT. ICLMAX) LOC-ICLMIN 
C ========== STOP SEARCH WHEN STARTING POINT IS REACHED 

IFtLQC.NE.LOCS) GO TO 100 

LOC-0 

RETURN 

END 


210 


BCS 40262-2 



o o o o 


CNUMER-C 

subroutine NUMERC(PHRS) ,RETURNStA) 

PURPOSES TO DETECT WHEN THE LEFT MOST CHARACTER IN A STRING 
IS NUMERIC 

CALL SEQUENCES: PHRS - STRING OF CHARACTERS 

RETURNS(A) - RETURN TAKEN IF CHARACTER IS NOT NUMERIC 
DIMENSION NUM(2^ 

DATA NUM/20H1234567890-.+ / 

C *> COMPARE FIRST CHARACTER TO NUMERICS 

I~ISCANtPHRS,l,l»NUH,l»14,Ml) 

IF(I-LE-O) RETURN A 

RETURN 

END 
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CNXTPH 

SUSaoUT INE NXTPH ( ICOK^ INDEX, I PHRS ) 

C PURPOSE: LOCATE NEXT PHRASE IN COMMAND STRING* 

C CALL SEQUENCES ICOM - COMMAND STRING 

C INDEX - INDEX TO NEXT CHARACTER TO 8E EXAMINED 

C IPHRS - NEXT PHRASE (RETURNED BLANK IF NONE FOUND I 

C delimiters; 3 OR MORE BLANKS, COMMA? EQUALS, LEFT OR RIGHT PARENTHES 

comhon/cio/iread,iwrite,idiag 

DIMENSION ICOM I U 

DATA IBLNK/IOH / 

IPMAXC^=10 

ICMAXC=80 

IPHRS=IBLNK 

C — - RETURN IF AT COLUMN UO 

IFC INDEX -GE*ICMAXC)RETURN 

C — ~ LOCATE FIRST NDN“BLANK, NON-DELIMITER CHARACTER 

150 DO 200 I-INDEX,ICMAXC 
CALL GETTaCDM,I,KAR) 

IF{KAR.EQ.lH,.DR.KAR*EQ.lH=.OR.KAR.EQ*IH{*OR.KAR*EQ.lHnGO TO 200 
IFlKAR.NE-IBLNKi GO TO 300 
200 CONTINUE 

INDEX=ICMAXC 

IFC IDlAG.GE*100aWRITE(IWRITE,25U INDEX, IPHRS 
251 FDRMATU4HNXTPHR2 INDEX=, 13, 1X,A10> 

C RETURN WHEN REST OF STRING IS EMPTY 

RETURN 

C LOCATE NEXT DELIMITER (END OF PHRASE) 

300 ISTART=I 

DO 400 I=ISTART,ICHAXC 
CALL GETT(IC0M,I,KAR3 

IFiKAR-EQ-lH,.OR-KAR.EQ-lH=.OR-KAR*EQ.lH( •0R»KAR»EQ»1H) )G0 TO 490 
IF(KAR-EQ-ISLNK) GO TO 350 
INBLNK=0 
GO TO 400 

350 IFdNBLNK-GE-PJ GO 10 500 
INBLNK=INBLNK+1 
400 CONTINUE 

INDEX=ICMAXC 
GO TO 600 
490 IST0P=I-1 
GO TO 510 
500 IST0P=I-3 
510 INDEX=I 

C 7£ST TO LIMIT PHRASE TO <= 10 CHARACTERS 

IF(ISTOP-ISTART-M.L£.IPMAXC) GO TO 700 
600 IST0P=ISTART+IPMAXC“1 

C TEST TO PREVENT PHRASE FROM GOING BEYOUND COL- 80 

IFdSTOP-GT.ICMAXC) TSTOP=ICMAXC 
700 INBLNK=ISTQP-ISTART+1 

C LOAD PHRASE 

CALL STRMDVtICDM,ISTART,INBLNK,IPHRS,l) 

IFdDIAG.GE-100.) WRiTE( IWRITE,80UIND EX, IPHRS 
801 FORMAT( 13HNXTPHR INDEX= , 13 , 1X,A10 ) 

RETURN 

END 
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CPUTCOD 

SUBROUTINE PUTCODCN,IARRAY,ICODE) 
purpose; place a 4 DIGIT CODE, VALUE OF CODE MUST BE BETWEEN 

2047 , STORED 5 CODES/WORDf FROM AN ARRAY OF PARAMETER 
CODES* THIS ROUTINE IS USED TO REDUCE THE STORAGE REQUIRED 
TO STORE THE I/O CODE LISTS FOR EACH ANALYSIS MODULE* 

CALL SEQUENCE; N LOCATION OF CODE IN ARRAY lARRAY 5 CODES/WORD . 

lARRAY INTEGER ARRAY WHICH RECIEVES CODE NUMBER. 
ICODE VALUE OF CODE INPUT TO ROUTINE. 

DIMENSION lARRAYCU 
MASK=7777B 

C DETERMINE WHICH WORD IN ARRAY IS TO BE MODIFIED. 

IWORD-CN-D/S+l 

C DETERMINE NO. OF BITS TO SHIFT CODE TO LEFT. 

ISHXFT?=(4-MQD{N-l*5i )>J=I2 

C SHIFT CODE + MASK TO PROPER BIT LOCATION IN WORD. 
ICOD“SHIFTCICODE,ISHIFT) 

MASK-SH I FT (M ASK , ISHI FT ) 

C PLACE CODE BITS INTO CORRECT LOCATION IN WORD OF lARRAY. 

lARRAYt lWORD)s=( lARRAYtIWQRDJ .AND. »N. MASK ) .OR. ( ICOD. AND. MASK) 

RETURN 

END 
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PUTT 


IDENT PUTT 
ENTRY PUTT 

+ VFD 18/0HPUTr42/3 

PUT BSS2 I 

PUTT EQU PUT 

SB4 30-1 . INITIALIZE MULTIPLE OF 10 COUNTER, 

SA4 Al'-B4 

SA2 X4 * PUT I IN X2, 

LOOP SB4 B4+1 . COUNT MULTIPLES OF 10. 

SX2 X2-10 , SUBTRACT 10 FROM I, 

ZR X2yDK . IF X2 ,LE. 0, EXIT FROM LOOP, 

PL X2,L00P . LOOP UNTIL NO MORE MULTIPLES OF 10 IN I. 

OR SA4 X1+B4 - . LOAD WORD TO RECEIVE THE CHARACTER, 

MX7 6 

SAB SIX 
SX2 X2-1 

PX2 80|X2 . PACK X2 

0X2 X2W . MULTIPLY BY SIX 

SA3 Al+2 

SA3 X3 , PUT T IN X3. 

S32 X2 

BX3 X3*X7 . MASK OUT LAST 9 CHAR, OF T. 

AX3 B2sX3 , SHIFT CHARACTER INTO POSITION, 

AX7 B2,X7 . SHIFT MASK INTO POSITION. 

BX6 -X7=4'X4 , MASK OUT CHARACTER IN S- 

BX6 X3+X6 . DR IN CHARACTER FROM T. 

SA6 X1+B4 . STORE IN PROPER POSITION IN STRING S. 

EQ BOfBOrPUT 

SIX DATA 200Q0000000000000006B 

END 
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STRHOV 


j IDENT STRHOV .CALL STRMOV{SA*LA»NA?SB,LB) 

* STRHOV REVISED TO ECONOMIZE ON FIELD LENGTHt EXECUTION TIME. 
REVISED BY BRUCE BAILEY 

I ^ BCS SCIENTIFIC SYSTEMS 

i MC'^ES NA CHARS FROM SA, STARTING IN POSITION LA, INTO SB, 

’ STARTING IN POSITION LB, A CHAR AT A TIME. REQUIRES LA,NA,LB 

ALL POSITIVE INTEGERS. IF INPUT ERROR, NO ACTION TAKEN. 

ENTRY STRHOV 

I 


a* 

STORE 

FINAL SB WORD - CAN 

. BE A REDUNDANT STORE. 

V70 

BX6 


X4 



SA6 


A4 



EQ 

BO 

, BO, STRHOV 


** 






VFD 

36/0LSTRHOV,24/5 


STRHOV 

PS 





SBl 


X 



SA5 


Al+BX 



SA2 


A5+B1 



SA5 


X5 

LA 


SA2 


X2 

NA 


ZR 


X5, STRHOV 

CHECK 


NG 


X5, STRHOV 

LA AND 


SA3 


Al+4 

LB 


SA3 


X3 



SE(2 


X5 

LA 


ZR 


X2, STRHOV 

NA FOR 


NG 


X2, STRHOV 

0 OR NEG 


ZR 


X3, STRHOV 

CHECK 


NG 


X3, STRHOV 

LB 

nr ^ 

INPUT 

OK 

“ START LOADING 

REGISTERS. 







SB7 


BO-ni 

TEMP TO DECOMPOSE LA AND LB. 


SB6 


B7-BI 



LT 


B2,B7,V20 

LA.LT.ll 

VIO 

SXl 


Xl+Bl 

TEMP ADR OF SA, FIRST WORD. 


SB2 


B2-*B6 

TEMP CHAR COUNT, SA. tABBR SAC) 


GE 


B2,B7,VX0 


V20 

S83 


B2+B2 

B3-2*SAC 


SA4 


AX+3 



SB2 


B3+B3 

B2-4^SAC 


SAl 


XI 

INIT VALUE IXI AND Al) 


SB3 


B2•^B3 

B3=6*SAC 


SB2 


B3-60 

B2=6=J^$AC-60 


SB5 


X3 

LB 


S52 


B0-B2 

B2=60-6>3:SAC, THE INIT VALUE. 


LT 


B5,67,V40 

LB.LT.IX 

V30 

SX4 


X4+BI 

TEMP ADR OF SB, FIRST WORD. 


SB5 


B5-B6 

TEMP CHAR COUNT, SB (ABBR SBC) 


GE 


B5,B7,V30 


V40 

SB6 


B5+B5 

2*SBC 


SB7 


B6+B6 

4=^^SBC 
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SB5 

BB+B? 

6=i^SBC, THE INIT VALUE. 


SA4- 

X4 

INIT VALUE {X4 AND A4> 


SB7 

B5-60 

6«SBC“60 


SB3 

X2 

INIT VALUE (NA) 


S0^ 

B0-B7 

60“65§=SBC, the INIT VALUE. 


HXO 

54 

INIT VALUE 


SB7 

BO+6 

INIT VALUE 



EXECUTION 

LQQPt IN-STACK 

. FETCHES AND STORES AS NEEDED. 


V50 

AX2 

B2tXl 

MOVE SA CHAR TO POS 10 


BX3 

-X0*X2 

CHAR 


LX5 

B5,X4 

POSITION SB WORD. 


SB2 

B2~S7 

DECREMENT SA SHIFT COUNTER. 


BX7 

X0*X5 

0 POSITION 10 


SB3 

B3-B1 

NB=NB-1 


BX6 

X7+X3 

SA CHAR IN SB WORD. 

4:4c 

LX4 

B6fX6 

REPOSITION SB WORD. 
INCREMENT COUNTERS. 


EQ 

B3,BO,V70 

IF NB-EQ.O {I.E.? DONE) 


GE 

B2,B0,V60 

IF RESET NOT YET NECESSARY. 


SAl 

Al + Bl 

RESET A1 AND XI FOR NEXT SA WORD. 


SB 2 

BO+54 

RESET B2 TD 54 

V60 

S85 

B5+B7 

INCREMENT FIRST SB SHIFT COUNTER. 


SB6 

B6-B7 

DECREMENT SECOND SB SHIFT COUNTER. 


GE 

B6,B0*V50 

IF RESET NOT YET NECESSARY. 


BX6 

X4 

REVISED SB WORD 


SAB 

A4 

STORE REVISED SB WORD 


SB5 

B7 

RESET B5 TO 6 


SA4 

A4+B1 

FETCH NEXT SB WORD, RESET A4 


SB6 

BO+54 

RESET B6 TO 54 


EQ 

END 

V50 

RECYCLE 
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5.0 PRINTER PLOT PROGRAM 


Lineprinter plots of simulation results are produced by a postprocessor pro- 
gram NSMPPT. This program is executed after the completion of the simulation 
program. NSMPPT reads simulation and scaling data from file TAPE30 and pro- 
duces the requested line printer plots. Figure 5.1-1 shows the macro flow 
diagram of NSMPPT. ^ 

Each unique channel of plot data is stored on file TAPE30, Channels, such as 
TIME, which may be used by several plots are stored only once. The format data 
describes how the channels are to be combined to form the plots. The individ- 
ual channel data are loaded into an array DSPLY. The data for each plot is then 
scaled and transformed to hollerith form and placed in the array GRAPHR. Title 
and scale information are also placed in this array to form the final plot 
configuration. 

The contents of GRAPHR are printed on the lineprinter to produce each plot. 
5.1 PRINTER PLOT PROGRAM SOURCE LISTINGS 

Compilation listings for the NSMPPT program follows. The names of the rou- 
tines, listed in alphabetical order, are: 


CENTER 

GNFPLT 

GRIDLI 

LEFTT 

LINPLT 

MNMX 

NCHAR 


NSMPPT 

PLOTC 

qpPLOT 

QXMXMN 

RTLPLT 

SIMPLT 

TNFPLT 
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i 
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I 



FIGURE 5.1-1 NSMPPT PROGRAM -.MACRO FLOW DIAGRAM 
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CCENTER 

SUBROUT IN5 CENTERC ARRAY ,NA rTITLE J 
CENTERING TITLES 


ARRAY CONTAINS CHARACTERS FOR TITLES OF PLOT 
NA “ NUMBER OF CHARACTERS IN ARRAY 
TITLE = ARRAY CONTAINING CENTERED TITLE 

DIMENSION ARRAYC1)»TITLE(1) 

DATA BLK/lOH / 

DO IQ I=irl2 
TITLE Cl )=BLK 
10 CONTINUE 

CALL NCHAR{ARRAYTNAirJSTART»NCH) 

IF {NCH*EQ-OJ GO TO 200 
NN={ 120~NCH)/2+l 
II=JSTART“1 
I=NN-1 
NEND=I1+NCH 
25 Ii=II+l 

1 = 1+1 

CALL GETT (ARRAY, II .AR) 

CALL PUTTCTITL£,I,AR) 

IF fll.LT-NEND) GO TO 25 
200 RETURN 
END 
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CGNFPLT 

SUBROUTINE GNFPLT 
READ (30) DUMMY 
IF .{ E0Ft30) ) 10,20 
10 K = 1 
20 RETURN 
END 
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CGRIDLI 

SUBROUTINE GRIDLI fNDVNAXT AMIN»AHAX»SMIN ,SMAXfNDIVrNSlS) 

PURPOSE - TO SELECT AXIS SCALES FOR A LINEAR AXIS. 

AMINsAMAX - MIN AND MAX VALUES OF THE DATA- 
SMINtSMAX - MIN AND MAX OF AXIS SCALES. 

NDIV “ NUMBER OF GRID DIVISIONS. 

NSIG - NUMBER OF SIGNIFICANT FIGURES FOR ANNOTATION. 

IN ~ 1 

IF ( SMIN .NE. 0.0 ..OR. SMAX .NE. 0.0 > GO TO 40 
SET AXIS INCREMENT TO lf2 OR 5 10^*N. 

IF ( ABS (AMIN-AMAXJ .LE. l.E-6H^AMAX ) AMAX - 1.000001*AHIN 
IF ( AMAX .EQ. 0.0 .AND. AMIN -EO. 0.0 1 AMAX = l.E-6 
SPAN “ ABS(AHAX«AMIN1 
STEP = SPAN / FLOATmOVMAX) 

N = ALDGIO(STEP) 

IF t STEP -LT. 1-0 ) N = N - 1 
X = STEP / 10.0*’»=N 
IF t X -GT. 2.0 ) GO TO 10 
STEP = 2.0 * 10.0*=4=N 
GO TO 30 

10 IF ( X -GT. 5-0 ) GO TO 20 
STEP = 5-0 ^ 10-0**N 
GO TO 30 

20 STEP - 10b0=4:*{N+1> 

IN = 0 
30 CONTINUE 

SET SCALE MAX AND MIN. 

HSTEP = STEP ^ 0.5 
SMIN = AINT(AMIN/HSTEP» * HSTEP 
IF ( AMIN .LT. 0.0 > SMIN = SMIN “ HSTEP 
SMAX = AINTtAMAX/HSTEP) * HSTEP 
IF ( AMAX .GT. O.O ) SMAX = SMAX + HSTEP 
X ~ AMODtABStSMINirSTEP i 

IF { X -GT- O.OOl^STEP .AND. X .LT. 0.999*STEP ) 

+ SMIN = SMIN “ HSTEP 
X = AMODE SMAX-SMIN , STEP ) 

IF I X .GT. 0.001*STEP .AND. X .LT. 0.999*STEP > 

+ SMAX = SMAX + HSTEP 

FIND NUMBER OF SUB-DIVISIONS - 

NDIV = (SMAX-SMIN) / STEP + 0,5 
GO TO 50 

FIND NUMBER OF SIGNIFICANT FIGURES. 

40 CONTINUE 

STEP - (SMAX - SMIN ) / FLDATtNDIV) 
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50 continue 

XMAX = AMAXKABStSMINi ,ABS(SMAXn 

NMAX = ALQGi0{XMAX*1.00Qi J 

NSTEP = ALOGIO(STEP) * 1.00001 

IF ( STEP .LE. 1.0 .AND. XMAX .GE. I.O i NSTEP 

IF ( STEP .GE. 10.0 > IN = 1 
NSIG = NMAX " NSTEP + IN 
RETURN 
END 


NSTEP - I 
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CLEFTT 

SUBROUTINE LEFTTi ARRAY, LA ) 
LEFT TITLE 


ARRAY CONTAINS CHARACTERS FDR LEFT TITLE 
LA = NUMBER OF CHARACTERS IN ARRAY 

DIMENSION ARRAYtl) 

COMMON/ C LE FTT/LE FT C 5 1 i 
COMMON/UNI T/IDUTP 
DATA BLK/4H /,NN/51/ 

BLANK OUT LEFT ARRAY 

DO 2 1=1, NN 
LEFT(I)=BLK 
CONTINUE 

IF (LA.EQ.O) RETURN 

CENTER TITLE IN LEFT ARRAY 

CALL NCHAR(ARRAY,LA,ISTART,NCH) 

IF (NCH.LE.NN) GO TO 25 
NCH=NN 
25 CONTINUE 

MUV=(NN-NCHl/a 
IEND=ISTART+NCH*1 
DO 30 I=ISTART,IEND 
MUV=MUV+1 

CALL GETT( ARRAYsIsLEFT(MUV) 1 
30 CONTINUE 

RETURN 
END 
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GLINPLT 

SUBROUTINE LINPLT(X,YtNTNTTtTT,NTU,TLTNTBl,TBl,NTB2,TBE,IAUT0) 
SUBROUTINE TO DRAW PLOT VIA PLOTC 


X - ARRAY or- POINTS FOR ABSCISSA 

Y = ARRAY OF POINTS FOR ORDINATE 

N - NUMBER OF POINTS TO BE PLOTTED 

NTT = NUMBER OF CHARACTERS IN TOP TITLE 

TT = ARRAY CONTAINING TOP TITLE 

NTL = NUMBER OF CHARACTERS IN LEFT TITLE 

TL = ARRAY CONTAINING LEFT TITLE 

NTBl = NUMBER OF CHARACTERS IN FIRST BOTTOM TITLE 
TBl ARRAY CONTAINING FIRST BOTTOM TITLE 

NTB2= NUMBER OF CHARACTERS IN BOTH SECOND AND THIRD BOTTOM TITLES 
TB2 = ARRAY CONTAINING BOTH SECOND AND THIRD BOTTOM TITLES 
TB2(I1,I-1,20 CAN CONTAIN ONLY SECOND BOTTOM TITLE 
TB2UJ, 1-21*40 CAN CONTAIN ONLY THIRD BOTTOM TITLE 
IAUT0=0 AUTOMATIC SCALING 
IAUTO=X AXIS VALUES PROVIDED IN ZSCALE 

DIMENSION Xtl),Ya)»TTll),TL(l),TBm),TB2(lJ 
DIMENSION TITLES (12) 

COMMON/UNIT/IDUTP 
IF (N.EQ.Oi RETURN 

CHECK FOR MULTIPLE CURVE PLOT 

IF {N.GT.0) GO TO 10 
CALL PLQTCiN?X,Y,lAUTO) 

RETURN 

CONTINUE 

DRAW PLOT WITH TITLES 


INDIGO 

IF (NTT.EQ.OJ GO TO 15 
CALL CENTERlTTtNTTiTITLES) 
WR1TE{IDUTP»10U TITLES 
15 IF CNTT^EQ.O) WRITE* I0UTP*50) 
CALL LEFTT(TL,NTL) 

CALL PLOTCfN,X*Y,lAUTa> 

IF (NTBl.EQ.O) GO TQ 20 
CALL CENTER(TB1,NTB1*TITLES> 
WRITE(IGUTP»100) TITLES 
20 CONTINUE 

IF INTB2.EQ.0) GO TO 40 
NDUM-NTB2 

IF (NTB2 .LE. 80) GO TQ 30 
INDl=l. 

N2=NTB2-80 

NDUM=80 

30 CALL CENTER(TB2tNDUMiTlTLES) 

WRITE tIOUTP, 100) TITLES 
IF UNDl*NE.l) GO TO 40 
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CALL CENTERCTBZr 9) ,N2» TITLES ) 
WRITE MDUTP» loot TITLES 
40 CONTINUE 

RETURN 

50 FORMATtlHl} 

100 FQRHATUH t6Xt12A10) 

101 FORMATC 1H1,6X,12A10> 

END 
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CMNMX 


SUBROUTINE MNMX ( A,N» AMIN,AMAX> 

PURPOSE - TO FIND THE MINIMUM AND MAXIMUM VALUES OF AN ARRAY. 

A - ARRAY OF VALUES. 

N - NUMBER OF ELEMENTS IN A. 

AMINiAMAX - MIN AND MAX VALUES FOUND* IF AMIN AMAX, THEN 
START WITH THE VALUES PASSED IN. ' 


DIMENSION Atll 

CHECK FOR ORIGINAL VALUES OF MIN AND MAX. 

IF { AMIN .GT. AMAX > GO TO 10 
IN - 1 

IF IN .LT. 1 ) RETURN 
GO TO 20 

INITIALIZE MIN AND MAX. 

10 CONTINUE 
AMIN = AdJ 
AMAX = Atl) 

IN = 2 

IF ( N .LT. 2 ) RETURN 

SEARCH. 

20 CONTINUE 

DO 30 I = IN*N 

IF ( AMIN -GT. A(I) I AMIN ~ A{It 
IF [ AMAX -LT. AU) > AMAX = A(Ii 
30 CONTINUE 
RETURN 
END 
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CNCHAR 

SUBROUTINE NCHARURRAY,MAXtISTART,NCH) 

C 

C SUBROUTINE TO CALCULATE THE NUMBER OF CHARACTERS IN A CHARACTER 
C STRING 

C 
C 

C ARRAY CONTAINS CHARACTER STRING 

C NA ~ NUMBER OF INPUT CHARACTERS 

C ISTART = NUMBER OF FIRST NONBLANK CHARACTER IN STRING 
C NCH = NUMBER OF CHARACTERS IN ARRAY SUPPRESSING BEGINNING 
C AND ENDING BLANK.S 

C 

DIMENSION ARRAYll) 

COMMON/UNIT/IOUTP 
DATA BLK/lOH / 

NCH=0 

J-0 

5 J=J+1 

CALL GETT(ARRAY,J,AR1 
IF (AR«NE*BLK1 GO TO 10 
IF C J.GE.MAXJ GO TO 100 
GO TO 5 

10 ISTART=J 

J=MAX+1 
15 J=J-i 

CALL GETT(ARRAY,J,AR) 

IF fAR.NE.BLK-i GO TO 20 
IF (J.LE.O) GO TO iOO 
GO TO 15 

20 NCH=J-rSTAftT+l 

IF (NCH.GE.Ol GO TO 25 
NCH=0 
GO TO 100 
25 CONTINUE 

IF (NCH.GT.120J NCH=120 
100 CONTINUE 

RETURN 
END 
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CNSMPPT 

PROGRAM NSMPPT tOUTPUT, TApE6-QUTPUTtTAPE30 ) 

NOMSIM OFFLINE PLOT PACKAGE- 

COMMON /CPLOTS/ lOPTOOJ ,PL0TID( 5),PTITLE{ 8} 
COMMON /CWORK/ WDRKi3131> 

COMMON /UNIT/ lOUTP 
lOUTP =6 
lERCNT = 0 
TEND =0 

READ THE OPTION AND TITLE ARRAYS. 

10 CONTINUE 

READ (30) IDPT,PLOTID,PTITLE 
IF ( EQP{30) > 500^12 
12 CONTINUE 

GENERAL PLOTS 

IF { lOPTlll .NE. 1 J GO TO 30 
CALL GNFPLT (WORK,50, 2^ lEND ) 

IF { lEND -NE. 0 J 60 TO 500 
GO TO 10 

SIMULATION PLOTS. 

30 CONTINUE 

IF { lOPTUi .NE. 2 ) GO TO 40 
CALL SIMPLT tWORK,IEND) 

IF { lEND -NE. 0 > GO TO 500 
GO TO 10 

ROOT LOCUS PLOTS. 

40 CONTINUE 

IF { IQPTCli .NE. 3 > GO TO 50 
CALL RTLPLT (W0RK,IEND) 

IF { lEND -NE. 0 J GO TO 500 
GO TO 10 

TRANSFER FUNCTION PLOTS. 

50 CONTINUE 

IF ( lOPTdi .NE. 4 ) GO TO 60 
CALL TNFPLT {WORK,WORKf iOOi J ,W0RK(2001) , XENDl 
IF ( lEND -NE. 0 > GO TO 500 
GO TO 10 

STEADY STATE PLOTS. 

60 CONTINUE 

IF ( lOPTll) .NE. 5 ) GO TO 400 
CALL SIMPLT (WORKsIEND) 


228 


BCS 40262-2 


IF ( lEND -ME. 0 1 GO TD 500 
GO TO 10 
C - 

J C ERROR 

C 

400 continue 

IF ( lERCNT -GT. 10 5 GO TO 500 
WRITE (6,410) 

410 FORMAT (///IX, 20 tIH* ) ,86H INCORRECT INTERMEDIATE PLOT DATA HAS BEE 
+N DETECTED. CONTINUATION WILL BE ATTEMPTED. ,20(lH+)///> 
lERCNT - lERCNT +1 
GO TO 10 
C 

C EXIT. 

C 

500 CONTINUE 
STOP 
END 
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CPLDTC 

SUBROUTINE PLDTCfMjXj Y» lAUTO) 

SUBROUTINE WHICH GALLS PLOTTING SUBROUTINE QPPLOT 


M = NUMBER OF POINTS TO BE PLOTTED 
X - ARRAY OF POINTS FOR ABSCISSA 
Y - ARRAY OF POINTS FOR ORDINATE 
IAUT0=0 AUTOMATIC SCALING 
lAUTO^l AXIS VALUES PROVIDED IN ZSCALE 

COHMON/ZSCALE/XMAXtXHIN»YMAX,YMlN 
DIMENSION XU), YU) 

DATA NUH /O/ 

N=H 

NUM=NUM+1 
L=IABSCMi 
IFtM.GT.O) NUM -0 
IFtNUM.LT-3} GO TO 10 

NUM -0 ^ V 

N=L 

10 CONTINUE 

IF {IAUTO*EQ.O^ CALL QXMXMNtX,Y» L,XMAX^XMINtYMAX,YMINJ 
CALL QPPLOT (X»XMAX,XMIN,Y,YHAX,YMIN,N) 

RETURN 

END 


CQPPLOT (' \ 

; SUBROUTINE QPPLOTtTBjTMAXfTMINtXDjXHAX-fXMINrNUMO i 

i C 

C PLOTTING SUBROUTINE 

C 

C 

j C TO = ARRAY OF POINTS FOR ABSCISSA i Y-AXIS) 

C TMAX - MAXIMUM VALUE FOR TD-ARRAY 

C TMIN = MINIMUM VALUE FOR TD-ARRAY 

: C XD s ARRAY OF POINTS FOR QROINATE (X-AXIS) 

C XMAX = MAXIMUM VALUE FOR XD-ARRAY 

C XHIN = MINIMUM VALUE FOR XD-ARRAY 

C NUMO = NUMBER OF POINTS TO BE PLOTTED 

C 
C 

C GRAPHR IS A REAL=4=4 ARRAY CONTAINING PLOT - DIMENSION = 32X52 

C GRAPH IS A L0GICAL=4=1 ARRAY OF DIMENSION 128X52 WHICH IS 
C EQUIVALENCED TO GRAPHR 

C GRAPHR( l»I)>I=lj51 CONTAINS VERTICAL AXIS 

C GRAPHRC 1*521,1=8,32 CONTAINS HORIZONTAL AXIS 

C REST OF GRAPHR CONTAINS BORDERS AND ACTUAL PLOT 

C 

COMHON/UNIT/IQUTP 

CQMMON/CLEFTT/LEFT(51) 

DIMENSION GRAPHRC14s 51) *HAXIS(25) ,SCALEtl01?PQINT(12) 

DIMENSION FMTR(3),FMTD(6) *FMTSt4) ,FMTB{8lTVALt2) 

I DIMENSION TD(l),XDti) »TX{2?2),TX0(2) ,RANGE(2),DlVt2},DELT£2) 

DATA SCALE /!• * 1 wS* 2 • * 3» * t 5« * 6 b , 8 • * 10» * 1 3 ■ / 

DATA R /O/ 

DATA POINT /1H>4=,XH1»1H2,1H3,1H4,1H5,1H6,XH7,1H8*1H9,1H ,1HX/ 

DATA BLEFT,BRIGHT,HORIZ /XOH-t- ,10H 1 

+ iOH / 

DATA NUMBER /10H5432 100000/ 

DATA blank /lOH / 

C 

C OUTPUT FORMATS 

C ! ' ' 

DATA FMTD /60H{ XX,AI , XX , XPE9.2 ,12A1 0 * All ( XX* AX*XX,F9,X *12A10,A 
+ 1 ) / 

DATA FMTB /80H ( 4Xt 1P12E10»2, IPE9.2/9X , IP 12E10-2 ) t4X,0P12F10* 

+1,OPF9-1/9X,OP12F10-1) / 

NUM=IABS(NUHO) 

C 

C K IS NONZERO IMPLIES MULTIPLE CURVE PLOTS 

c 

IF{KbNE.O)GQ TO 1000 
50 CONTINUE 
IWT=0 
IP=0 

IFtNUMO*LTBO)lP=I 
- TX(1*1)=TMIN 

TX{1,2)=TMAX 
TXt2,l)=XMIN 
TX(2,2)=XMAX 
VALt21=1.0 
VALC1)=X-2 
R0UND=,9999 
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C 

C DETERMINE EVEN SCALES 
DO 600 L-\i2. 

RANGElL)==A8S(TXa,Zl“TXlL,l) ) 

CHECK FOR CONSTANT VALUE 

IF(RANGEtL).EQ-0-iRANGE(U=2.«ABS(TX(L,l) ) 
IF{RANGE{L),E0.O«)RANGEtL)-IO- 
N^ALDGIQ (RANGE (D) 

IF { RANGE tU ,LT.1,)N=N-1 
EXPN=VAL(U*10.^^N 
DO 100 M=l,9 
K=M 

IF(SCALEtMi=J=EXPN.GE«RANGEtL)*ROUND>GD TO 150 
100 CONTINUE 
150 CONTINUE 

RANGE (U=SCALE(Ki*EXPN 
DIV{Li=RANGE(LJ/10./VAL{U 

TXMAX=AMAXUABS(TX(L,1) ) tABSC TX(L»2 ) ) )+R0UND 
IF(TX(L,2)^TX(L,1).GE.0.)G0 TO 300 

TRY TO CENTER SCALE ABOUT ORIGIN 

IF(RANG6(L)/2-.LT.TXMAX>GD TO 500 
TX0(L)=-RANGECLi/2. 

GO TO 600 
300 CONTINUE 

TRY TO START DR END SCALE AT ORIGIN 

IFtRANGE(L).LT.TXMAX>GO TO 500 
TXQ(L)s=0- 

iF(TXlLjl) •LT.O.>TXO tU=-RANGECL) 

GO TO 600 
500 CONTINUE 

FIND ORIGIN OF SCALE 

TXO(U=TXEL»lS-AMODtTXtLjl)»DIVlU ) 

IF£TX0( Li,GT.TX(L,lHTXO(U=^TXO{L)-DIVtL) 

INSURE THAT ALL POINTS FALL WITHIN SCALE RANGE 

IF(TXO(Li+RANGE(LUGE.TXtL,2>*ROUND>GO TO 600 
K=K-f-l 
GO TO 150 
600 CONTINUE 

BLANK OUT PAGE 

DO 620 I-2t 13 
DO 620 J=lt51 
GRAPHRt I,J)=BLANK 
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620 CONTINUE 

DELTU)-DIV( 11/10- 
DELT(2l=DIVt2>/5. 

C 

C DEFINE VERTICAL AXIS AND BORDERS 

C 

ICENTR=0 

l0“IFIXtl.5-TX0aj/DELT{l) ) 

IF(IO-LT.1,QR.IO.GT.1211ICENTR-1 

IF(ICENTR-EQ-1)I0=1 

I2ER0=0 

IF{ ICENTR-NE.il IZERQ-IO/10 
XS=TX0{2)+RANGE(2)+DELT{21 
00 650 J=1,51 

CALL PUTT (GRAPHRf2*J) ?1,1H > 

CALL PUTT lGRAPHRt2 ,J) t121,1H ) 

650 CONTINUE 

IF ( 10 -LE- 1 -OR. 10 -GE- 121 1 GO TO 670 
DO 660 J“l,51 

CALL PUTT (GRAPHR(2,J1 ,I0tIH-1 
660 CONTINUE 
670 CONTINUE 

DO 700 J=l»51»5 
GRAPHRUtJl^XS-J’f^DELTtZ) 

CALL STRHOV (BLEFT » 1 GRAPHR (2 , J ) ♦ 1 1 
CALL PUTT IGRAPHRSZ^JItIOtIH-M 
GRAPHR{ 13s J}~8RIGHT 
CALL PUTT {GRAPHR(29Jlf 121slH+) 

700 CONTINUE 
C 

C DEFINE HORIZONTAL AXIS AND BORDERS 

C 

JO=IFIX{51.5+TXO(21/DELT{2n 
IF( JO.LT.1.0R.JO.GT,51)ICENTR=2 
IFtICENTR-EQ.2) J0=51 
J=0 

Divm-Divai/2. 

TS“TXO( U 
HAXIsm = TS 
DO 750 1=2,13 
J=J+1 

HAXISd + 121 = TS + J =4= DlVdl 
J=J + 1 

HAXIStI 1 = TS + J * Dive 1) 

750 CONTINUE 
C 

C AVOID ROUNDOFF IN CALCULATING ZERO POINT OF SCALES 

C 

IF(I2ERO.GT.O)HAXIS4IZER J1 = 0. 
IFUCENTR.NE.ZIGRAPBRU, J0)=0. 

DO 850 1=2,13 
GRAPHRC I,11=H0RIZ 
GRAPHRt I,JO)=HORIZ 
GRAPHRtI,511=HDRIZ 
850 CONTINUE 

DO 900 1=1,121,5 

CALL PUTT (GRAPHR{2,1) ,1, 1H+) 


BCS 40262-2 


233 


ooo ooo ono ooo on 


CALL PUTT (GRAPHR(2»J0) 

CALL PUTT {GRAPHR(2,5D 
900 CONTINUE 

DO 910 I = ll,iUtI0 

CALL PUTT (GRAPHR{2y2),ItLH.) 

CALL PUTT {GRAPHRt2,3),I*lH.) 

CALL PUTT tGRAPHR(2r49) IH.) 

CALL PUTT (GRAPHR{2,503 ,If IH.) 

910 CONTINUE 

IF t ICENTR «EQ, 0 ) CALL PUTT IGRAPHRC2» JOIt lOj IHO) 

C 

DEFINE FORMAT STATEMENT ACCORDING TO NUMERICAL RANGE OF DATA 

TXMAX»AMAXi{ABS(GRAPHR(l*I) ),ABS(GRAPHRt lf51) )> 
NS=AL0G10(TXMAX>-»'3-0001 
J=3 


WILL AN FORMAT BE REQUIRED FOR THE VERTICAL AXIS 

IF (NS.LT.1.QR.NS.GT.8J J=0 
DO 920 I“l,3 
FMTR( I)=FMTD( I+U3 
920 CONTINUE 

IF{J,EQ.O)GO TO 950 
NR=ALOG10f RANGE { 2) ) +3.0001 
IFtNR.GT.NSmR=NS 

INSURE THAT THE FIELD CAN CONTAIN THE LARGEST NUMBER 

NS=MAX0{ lfNR«NS-2i 
CALL GETT (NUMBER, NS, IJ) 

CALL PUTT (FMTR,14,IJJ 
950 CONTINUE 

TXMAX = AMAXL ( A6S(HAXIS{ I) > ,ABS( HAXISC25 1) ) 

NS=A LOG 10 { TXMAX J +3-000 1 
J = 4 

WILL AN FORMAT BE REQUIRED FOR THE HORIZONTAL AXIS 

IF {NS-LT.1.0R.NS.GT.8) J=0 
DO 970 1=1,4 
FMTS{I)=FMTBtI+J) 

970 CONTINUE 

IF IJ.EQ.O) GO TO 1000 

NR=ALOG10tRANGE{l)i+-3-0001 

IF(NR.GT.NSiNR-NS 

INSURE THAT THE FIELD CAN CONTAIN THE LARGEST NUMBER 


NS=MAX0{1,NR,NS“2J 
CALL GETT (NUMBERsNS, IJ ) 
CALL PUTT (FMTS,13,IJ1 
CALL PUTT (FMTS,20,IJ3 
CALL PUTT (FMTS,33,IJ) 
1000 CONTINUE 
IP=IP+1 
IDFF=1 
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IFdP.GT.lUOFF-lP-l 

M=0 

DO 1500 L=1,NUM 
L0C=IP 

I=IFIXt l-5+tTDa)“TX0(l>)/DELT(l) } 

IF(I.LT-l»aR,I*GT.121JG0 TO 1200 
J=IFIX(51.5-rX0(U‘“TX0C2) i/DELTf2) ) 

IFU.LT«l,0R.d*GT*5llGQ TO 1200 

CHECK FOR MULTIPLE POINTS 

CALL GETT CGRAPHR(2* J ) j I » PGRAPHi 

IF ( PGRAPH ,EQ* PDINTdP) ) GO TO 1500 

IF t PGRAPH .EQ. PQINTU) > GO TO 1500 

THIS CHECK IS MACHINE DEPENDENT - CDC 6600 

IF t PGRAPH .GT, PDINTC2) .AND. PGRAPH .LE. POINTdO) i LOC 12 
CALL PUTT (GRAPHR12, J) drPOINTtLOCH 
GO TO 1500 
1200 CONTINUE 
IWT=1 
M=M+1 

1500 CONTINUE 

IFCNUMO .LT.Oi.AND.IP.LT. 10)G0 TO 2000 
K=0 


WRITE OUT PLOT 
DO 1700 1=1,51 

IF tMQDi 1,5) .EQ.l) GO TO 1600 

WRITE a OUTP, 1550) LEFT { I ) , ! GRAPHR { J , I ) , J=2 , 14} 
1550 FORMAT { IX ,A1 , lOX , 12A10 , A1 ) 

GO TO 1700 

1600 WRITE[IDUTP,FMTR} LEFT t I > , t GRAPHR { J , I ) ,J=1 , 14) 
1700 CONTINUE 

WRITEilOUTPrFMTS) tHAXIS( J ) ,J=1,25) 

2000 CONTINUE 
RETURN 
END 


BCS 40262-2 


235 



nooonoooonnn 


CQXMXMN 

SUBROUTINE QXMXMNfX^Y ,NfAMAXf AMIN fOMAXtOMIN) 

SUBROUTINE TO DETERMINE MINIMUM AND MAXIMUM VALUES OF ARRAYS 


N = NUMBER OF PLOT POINTS 
X =: ARRAY OF POINTS FOR ABSCISSA 
V = ARRAY OF POINTS FDR ORDINATE 
AMAX = MAXIMUM VALUE IN X-ARRAY 
AMIN = MINIMUM VALUE IN X-ARRAY 
DMAX := MAXIMUM VALUE IN Y-ARRAY 
QMIN = MINIMUM VALUE IN Y-ARRAY 

DIMENSION XtDjYCU 

AMAX=-1 -E50 

AMIN=1.E50 

0MAX=-1.E50 

OMIN=1.E50 

DO 1 1=1, N 

AMAX=AMAX1 (X(X) lAHAX) 
AMIN=AMINUXM} ,AMIN) 

DMAX =AM AXi ( Y { I ) , OM AX ) 
OMIN=AMINl{Y(I) tOMIH) 

1 CONTINUE 
RETURN 
END 
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CRTLPLT 

SUBROUTINE RTLPLT tRODT,IEND) 

PURPOSE “ TO BUILD A ROOT LOCUS PLOT FOR NONSIM. 

ROOT - A WORK SPA.CE INTO WHICH DATA IS READ. 

COMMON /CPLOTS/ IDPT* ICASEtDATECZ ] , RLPAR , SCALRC 3 ) ,SCALI 13 ) 
+ INDEX, DUMMYt 18), PLOTIDt 5),PTITLE( 8) 

COMMON /ZSCALE/ SMAXR,SMINR,SMAXI ,SMINI 

DIMENSION ROOTtl) 

DIMENSION ZBFR(16) 

DIMENSION XUOOO) , Y 1 1000 ) , GAIN (4, 50 ) , IGA IN ( A-, 50 ) 
EQUIVALENCE {GAINll,!) , IGAINC 1,1) I 
DATA EPI yi.OE-4/ 

READ ROOT ARRAY. 

READ (30) (ROOT m, 1=1, INDEX) 

IF ( EQF{30> ) 270,5 
5 CONTINUE 

FIND MAX AND MIN VALUES. 

RMIN =1.0 
RMAX = 0.0 
YMIN =1.0 
YMAX =0.0 
1 = 1 

10 CONTINUE 

N = ROQTtI) + 0.1 
CALL MNMX (RDQTM-i-3) ,N,RMIN,RMAX) 

CALL MNMX (ROQTd+S-J^N) ,N»YMIN,YMAX) 

1=1+ 2+N + 3 
IF { I .LT. INDEX ) GO TO 10 
IF ( YMIN .LT. 0-0 k YMIN = 0.0 

C FIND SCALE VALUES, IF THEY ARE NOT PROVIDED - REAL. 

C 

IF I SCALRU) .LT. SCALR(2) ) GO TO 30 
20 CONTINUE 
SMINR = 0-0 
SMAXR = 0.0 
lAUTO = 0 

CALL GRIDLI ( 12, RMIN, RMAX, SMINR, SMAXR, NDIVR ,NSIGR) 

GO TO 50 
30 CONTINUE 

SMINR = SCALRU) 

SMAXR = SCALR(2) 

I AUTO = 1 
50 CONTINUE 
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FIND SCALE VALUES, IF THEY ARE NOT PROVIDED “ IMAGINARY- 

IF { SCALIUL -LT. SCALIt2> ) GO TO 70 
60 CONTINUE 
SMINI - 0.0 
SMAXI = 0.0 

CALL GRIDLI (I2,YMIN,YMAX,SMINI^SMAXI,NDIVI,NSIGI) 

GO TO 90 
70 CONTINUE 

SMINI = SCALItl) 

SMAXI = SCALIC2) 

90 CONTINUE 

EPZR = (SMAXR“SMINR> ^ 0.002 
EPZI X (SMAXI-SMINI) * 0.002 

DECOMPOSE ROOT ARRAY AND GUARANTEE SEPARATION OF ROOTS. 

X(l) = 1.E69 
Y(l) = 1.E69 

I - 1 
N = 0 
NR = 0 
INDRT = 0 

100 CONTINUE 

IF ( I .GT. INDEX > GO TO 160 
NN = RODTU) + 0.1 
NR = NR + 1 
GAINUtNR) “ RDOTd+li 
GAIN(2,NR) = R00T(1+2J 
IGAIN(3,NR) = N + 1 

II = I + 2 
12 = II + NN 

IF ( GAIN(2,NR) .EQ. 5.0 .AND. INDRT .EQ. 1 } GO TO 120 

IF { GAIN(2,NR) .EQ. 5.0 ) INDRT = 1 

DO 110 J-1,NN 

N = N + I 

XIN) = ROOTill+J) 

Y(N) = RQ0T{I2+JJ 
110 CONTINUE 

IGAIN{4»NR) = NN 
GO TO 150 
120 CONTINUE 
NK = 0 

DO lAO J=1,NN 
RR == ROOTdl+J) 

RI = RD0T(I2+J) 

IF t ABStRRi .LE. EFZ ) RR = 0.0 

IF ( ABSCRIJ .LE. EPZ ) RI = 0.0 

DO 130 X=1,N 

IF C ABS(RR-*X(K) r .GT. EPZR } GO TO 130 

IF C ABSCRI-Y(R)) .LE. EPZI ) GO TO 140 

130 CONTINUE 

NK = NK + 1 
N = N + 1 
X(N) = RR 
Y(N) = RI 
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140 CONTINUE 

I6AIN(4,NR) = NK 
IF t NK -LE. 0 > NR = NR - 1 
150 CONTINUE 

I = I + 3 + 2 ❖ NN 
GO TO 100 

GENERATE LABELS AND PLOT ON PRINTER 
160 CONTINUE 

ENCODE C80j250,ZBFR) RLPAR 
250 FORMAT (23HR00T LOCUS PARAMETER ^ ,A8,49XI 
ENCODE (80»260TZBFRf9) > DATE,ICASE 
260 FORMAT {2A12 t 14X,15HRDDT LOCUS PLDT,15X»8HCASE NQ.»I4) 
CALL LINPLT (XyYTN,ao*PTlTLE» 10,10HIMAGINARY ,4,4HREAL, 
4- 160tZBFRTlAUTD) 

ADVANCE FILM AND RETURN 

RETURN 

270 CONTINUE 
lEND = 1 
RETURN 
END 
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CSIHPLT 

SUBROUTINE SIMPLT IDSPLYtlEND) 

PURPOSE “ TD BUILT A SERIES OF SIMULATION tOR STEADY-STATE) 
PLOTS, UP TO FIVE GRIDS PER PLOT* 

DIMENSION DSPLY{3131),VAR(31) 

COMMON /CPLOTS/ lOPT, ICASE,DATE«2) ,NPLT,NGRD(63 , INDEX, NCODES, 
+ IMANUL,NWDRK,DUrtMYa5),PLQTID( 5),PTITLEt8} 

COMMON /ZSCALE/ XMAX ,XMIN , YMAX,YMIN 

DIMENSION SCALEt5,4,6) ,PNAME(5,2,6) ,NPOS(5,2,6) 

DIMENSION ZBFRtS) 

DATA BLNK /lOH / 

READ DATA- 

READ {30) SCALE, PNAMEjNPOS 
IF I EQFt30) ) 500,3 
5 CONTINUE 

READ SIMULATION DATA- 
IL - 0 

INDMAX = 3131 / NCODES 
100 CONTINUE 

II = IL + 1 
IL = IL + INDMAX 
IF { INDEX .LT. IL ) IL = INDEX 
INDX - IL - II + 1 
J = 0 

DO 130 1=11, IL 
J = J + 1 
READ t30) VAR 
IF t E0FC30) ) 500,110 
110 CONTINUE 

DO IZO K=l, NCODES 
DSPLY( INDMAX* (K-U+J) = VAR(K) 

120 CONTINUE 
130 CONTINUE 

INCREMENT OVER THE NUMBER OF PLOTS AND THE NUMBER OF GRIDS - 

DO 60 IP=1,NPLT 
NG = NGRD(IP) 

DO 40 IG=1,NG 

SET SCALE VALUES IF REQUIRED- 
lAUTO = 0 

IF ( IMANUL -EQ- 1 ) GO TO 10 
GO TO 20 


240 


BCS 40262-2 



o n o o o o 


10 CONTINUE 

IF { SCALEaG,l,IP) ,GE. SCALE? IG,2,IP> .OR,. 

+ SCALEUGtSTlP) .GE. SCALE ( IG ,4, 1 PI > GO TO 20 
lAUTQ =1 

XMAX = SCALE? IG»4, IP) 

XMIN = SCALE?IGr3,lP> 

YHAX = SCALEIIGt2,IP) 

YMIN = SCALEaG,l,IP) 

20 CONTINUE 

TITLES AT TOP OF PLOT- 

IF ( lOPT .EQ* 5 ) GO TO 52 
ENCODE ia0,50tZBFR) DATE,IP, ICASE 
50 FORMAT ( 2A12 » I2X, 18HSIHULATION DISPLAYtI2, 12Xt8HCASE NO., 14) 
GO TO 58 
52 CONTINUE 

ENCODE (80,54,ZBFR> DATE, IP, CASE 

54 FORMAT ( 2A12, IIX, 20HSTEADY STATE DISPLAY , 12 , 1 IX, 8HCASE NO. ,14) 
58 CONTINUE 

CALL PRINTER PLOTTER 

INX = INDHAX * tNPDS(IG,2,IP)-X) + 1 
INY = INDMAX + tNPOStlGfl, IP)-1> + 1 
CALL LINPLT t DSPLY { INX) ,DSPLY ( INY ) , INDX, 80 , PTITLE , 

+ 8,PNAMEtIG,l,IP) t8,PNAME(IG,2,IP),80,ZBFR,IAUTO) 

40 CONTINUE 
60 CONTINUE 

IF ( IL+1 .LT. INDEX ) GO TO 100 
RETURN 

500 CONTINUE 
lEND = 1 
RETURN 
END 
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CTNFPLT 

SUBROUTINE TNFPLT lFjG,P,K) 
READ {30} DUMMY 
IF { E0FC301 ) 10*20 
10 K = I 
20 RETURN 
END 
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